{ Rum.dfn 

Definitions for Rum, the Dandelion Smalltalk-80 rnicrocoded virtual machine, 
by P McCullough, J Trow, J Susser, M Udagawa, T Tokutiaga 
20-Jan-86 20:57:19 

Copyright 1983, 1984, 1986, 1986 by Xerox Corporation. All rights reserved. } 


{+++++ Control store definitions ++++■*•} 


SetTask [0]; 


Reserve [0F6F]; 

Reserve [0F77]; 

Reserve [0F7F, OFFF]; {Save space for the Kernel} 


{ ’’bytecode" macro utilized to build the bytecode dispatch table} 
MacroDef [bytecode, at [Add [//1, bytecodeBase]]]; 

Set [bytecodeBase, 800] {as good a place as any}; 


{The following macro dispatches to the next bytecode interpreter and sets 1.3 to zero} 
MacroDef [NextBytecode, (IBDisp, L3 <- 0)]; 


{ Definitions for setting the control store bank register } 

Set [mcmoryStateO, 0]; {display banks are 0, 10, 80, 90} 

Set [memoryStatel, 4]; (display banks aro 0, 10} 

Set [memoryState2, 8]; {display bank is 0} 

Set [memoryState3, OCj; {display banks are 0, 10-1F, 90-9F} 

Set [csBankO, Add [0, memoryStatel]]; 

Set [csBankl, Add [1, memoryStatel]]; 

Set [cs8ank2, Add [2, memoryStatel]]; 


{ Definitions of known Pilot stuff } 

Set [mouseBank, 2]; 

Set [mouseX, 3B]; {must be less than 100} 

Set [mouseY, 3C]; {must be less than 100} 


Set [needToStabilize, 1]; 


Set [notYetlnvented, 1]; 

Set [bytecodeFailed, 2]; 


{+++++ Hardware register definitions +■<•+++} 


{register equates for the fourteen R and RH interpreter registers} 


RegDef [ipHIgh, 

RH, 

0]i 

RegDef [ipLow, 

R, 

o]; 

RegDef [stackHIgh, 

RH, 

i]: 

RegDef [stackLow, 

R, 

i]; 

RegDef [homeHIgh, 

RH, 

2]: 

RegDef [homeLow, 

R, 

2]; 

RegDef [otHigh, 

RH, 

3]i 

RegDef [otLow, 

R, 

3]; 
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RegDef [templHigh, 
RegDef [templLow, 

RegDef [temp2H1gh, 
RegDef [temp2Low, 

RegDef [temp3High, 
RegDef [temp3low, 


RegDef [objectSizo, 
RegDef [oopCount, 

RegDef [sourcelligh, 
RegDef [sourceLow, 
RegDef [otlndex, 

RegDef [wordCountHigh, 
RegDef [worUCountLow, 

RegDef [nimHIgh, 

RegDef [ruinLow, 

RegDef [destHigh, 
RegDef [destLow, 

RegDef [objectHigh, 
RegDef [objectLow, 


RH, 

4]; 



R. 

4]; 



RH, 

6]; 



R, 

6]: 



RH, 

6]; 



R, 

6]; 



R, 

0]: 

{for 

compactor} 

R. 

o]; 

{for 

compactor} 

RH, 

i]; 

{for 

compactor} 

R, 

i]; 

{for 

compactor} 

R, 

VI; 

{for 

compactor} 

RII, 

i]: 

{ F or 

compactor} 

R, 

i]; 

{■ or 

compactor} 

RH. 

23; 

{for 

compactor} 

R, 

2]; 

{for 

compactor} 

RII, 

4]; 

{for 

compactor} 

R, 

43; 

{for 

compactor} 

RH, 

53; 

{for 

compactor} 

R, 

s]; 

{for 

compactor} 


{Register equates for saving the address of the Rum Communications Record -- these registers are completely unused by Mesa. This is 
essential if we are to continue Rum microcode after going to the Mesa debugger (or any other non-smalltalk XDE volume} 

RegDef [uRumRecordHIgh, U, 49]; 

RegDef [uRumRecordLow, U, 5F]; 


(U register definitions} 


< 


{ 

t 

{ 


{ 


RegDef [uLargelntegerValueHigli, 
RegDef [uLargelntegerValueLow, 

u, 

u, 

14]; 

17]; 

RegDef [u3FFF, 

u, 

15]; 

RegDef [uAtPutValue, 

u, 

19]; 

RegDef [uZctBaseHigh, 

u, 

la]; 

RegDef [uZctSweepHigh, 

RegDef [uZctSweepLow, 

u, 

u. 

lb] ; 

lc] ; 

RegDef [uZctBaseLow, 

u. 

Id]; 

RegDef [uAtPutLow, 

u. 

la]; 

RegDef [uTimcToStabilize, 

u, 

if]; 

RegDef [uAtlndex, 

U, 

24]; 

RegDef [ulFFF, 

u, 

36]; 

RegDef [u7FF, 

u, 

2F]; 

RegDef [MesaStateL, 

u, 

30];> 


{** constant initialized by Mesa}} 


{used in stabilizer} 

{used in stabilizer} 

{used in stabilizer} 

{reserved by stabilizer} 

{** constant Initialized by Mesa}} 
{** constant initialized by Mesa}} 
{&&} 


RegDef [uMakeVolatileOop, U, 31]; {used in makeVolat lie} 

RegDef [uNewObject, U, 31]; {used in createlnstance; referenced in actlvateNewMethod} 

RegDef [uQueueHead, U, 31]; {used in stabilizer} 


RegDef [MesaStateRhL, 


U, 33];} {&&} 


RegDef [uClassToInstantlate, U, 34]; {input parameter for createlnstance} 

RegDef [uFieldType, U, 35]; {used in createlnstance} 


RegDef [uReceiverOop, 


U, 2E]; {smashed in activateNewMethod} 


RegDef [uDefault, 

RegDef [uRequestedSize, 


U, 37]; {used in createlnstance} 
U, 38]; {used in createlnstance} 


RegDef [uNewRecelver, U, 3a]; 


RegDef [uNewMethodOop, 


U, 3b]; {referenced in activateNewMethod} 


RegDef [uNewContextOop, 
RegDef [uPredecessor, 
RegDef [uCurrentObject, 


U, 3c]; {smashed in activateNewMethod} 
U, 3c]; {used in createlnstance} 

U, 3c]; {used in stabilizer} 


RegDef [uNewClassHIgh, U, 42]; 

RegDef [uNewClassLow, U, 43]; 


RegDef [uNewObjectHigh, 
RegDef [uNewObjectLow, 


U, 42]; {used In makeVolatlle} 

U, 43]; {used in createlnstance} 


RegDef [uMakeVolatileHigh, 


U, 44]; {used in makeVolatlle} 
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RegDef [uCurrentObjectBasel-Qw, 

U, 44]; {used in deallocate} 

{ 

{ 

RegDef [MesaStateG, 

RegDef [MesaStateRhG, 

U. 45];} {&&} 

U, 46];} {&&} 


RegDef [uMakeVolatileLow, 
RegDef [uSoFar, 

U, 47]; {u : ed In makeVolatlle} 

U, 47]; {used in deallocate} 


RegDef [uWrap, 

RegDef [uSoFarHigh, 

RegDef [uSaveHome, 

U, 48]; 

U, 48]; {used In deallocate} 

U, 48]; 


RegDef fuArgumentCount, 

RegDef [uOtHIgh, 

U, 4a]; 

U, 4a]; 


RegDef [uNowRece1versCIass, 
RegDef [uMemLimItHigh, 

U, 4b]; 

U, 4b]; 


RegDef [uNewRecoiverHigh, 
RegDef [uDestLow, 

U, 4c]; 

U, 4c]; 


RegDef [uNewMethodlligh, 

RegDef [uNewMethodLow, 

U, 4d]; 

U, 48]; 


RegDef [uNewReceivorlow, 

U, 4f]; 

{ 

{ 

RegDef [MosaStatePC, 

RegDef [MesaStateRhPC, 

U, 50];} {&&} 

U, 61];} {&&} 

{ 

{ 

{ 

RegDef [MesaStatePCIO, 

RegDef [MesaStatelBPtr, 

RegDef [MesaStatelB, 

U, 52];} {&&} 

U, 53];} {&&} 

U, 54];} {&&} 


RegDef [uHash, 

U, 55]; 


RegDef [uMothodCacheHIgh, 
RegDef [uMethodCacheLow, 

U, 56]; {&&} 

U, 57]; {&&} 


RegDef [uSelectorsStartInDIctlonary, U, 58]; 


RegDef [uSmashTos, 

U, 59]; 


RegDef [uZctLimlt, 

U, 59]; {used in stabilizer} 


RegDef [uActiveContextll igh, 
RegDef [uActiveContextLow, 

U, 5a]; {referenced in activateNewMethod} 
U, 5b]; {referenced In actlvateNewMothod} 


RegDef [uPrlmitIveNumber, 

U, 5c]; 


RegDef [uNewMethodHeader, 

U, 5d]; {referenced in actlvateNewMothod} 


RegDef [uNextFreeChunk, 

RegDef [uClass, 

U, 60]; {used In create Instance} 

U, 60]; {used In deallocator} 


RegDef [uSelector, 

U, 63]; 


RegDef [uHomeLow, 

U, 64]; {&&} 

{ 

RegDef [MesaStateRhMDS, 

U, 65];} {&&} 


RegDef [uCurrentMethodHIgh, 
RegDef [uCurrentMethodLow, 

U, 66]; {smashed In activateNewMethod} 

U, 67]; {referenced in activateNewMethod} 


RegDef [uRecelverHigh, 

RegDef [uReceiverLow, 

U, 68]; {smashed In activateNewMethod} 

U, 69]; {smashed In activateNewMethod} 


RegDef [uHashedSelector, 

U, 6a]; 


RegDef [uLastPoInter, 

U, 6b]; {used In makeVolatlle} 


RegDef [uActiveContextOop, 

U, 6c]; {referenced In activateNewMethod} 


RegDef [uReturnValue, 

U, 6d]; 


RegDef [uCurrentFreeChunkOop, 

U, 6d]; {used In create Instance} 


RegDef [uMakeVolatlleLInkage, 

U, 6e]; {used In makeVolatlle} 


RegDef [uStartLookup, 

U. 6f]; 


{Float:} 

{Register Definition} 

RegDef [uArgValueHIgh, U, 14], 

RegDef [uArgValueLow, U, 17], 

RegDef [uResultSIze, U, 19], 

RegDef [uLargeReceiverHIgh, U, 1A], 

RegDef [uLargeRecelverLow, U, IE], 

RegDef [uResultO, U, 2 {24}], 

RegDef [uResultl, U, 3 {3A}], 

RegDef [uResuU2, U, 4 {3B}], 

RegDef [uResolt3, U, 5 {4A}], 

{BankFlug return adress U register} 
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RegDef [uReturnAdSave, U, 6 {4F}], 

{qFotchByte subroutine working register} 

RegDef [uSave, U, 7 {4D}], 

{BankPlug return address U register} 

RegDef [uReturnOankO, U, 8 {4E}], 


RegDef 

[floatT, 

R, 

2]; 

{ 

temporary for float dividing } 

RegDef 

[floatTemp, 

R, 

31; 




RegDef 

[divCount, 

R, 

3]; 

{ 

temporary for float dividing } 

RegDef 

[divResult. 

R, 

4]; 

{ 

temporary for float dividing } 

RegDef 

[divisorHigh, 

R, 

6]; 

{ 

temporary for float dividing } 

RegDef 

[d i visorLow, 

R, 

6II; 

{ 

temporary for float dividing } 

RegDef 

[uArg lHi, 



u, 

14]; 

{ used in divide or compare } 

RegDef [tiArglLo, 



u. 

1?]; 

{ used in dovlde or compare } 

RegDef 

[uHlgliHairi, 



u, 

19]; 

{ divide } 

RegDef 

[uExpl, 



u, 

1A]; 

{ divide } 

RegDef 

[iiLowllal fl. 



u, 

IB]; 

{ divide } 

RegDe f 

[uExp2, 



u, 

1C]; 

{ divide } 

RegDef 

[uH1ghllalf2, 



U, 

ID]; 

{ divide } 

RegDef 

[iiLowllal f2, 



u. 

iE]; 

{ divide } 

RegDef 

[uStickyReg, 



u. 

24]; 

{ divide } 

RegDef 

[uStickyBit, 



U, 

31]; 

{ divide } 

RegDef 

[uSignl, 



u. 

34]; 

{ divide } 

RegDef 

[uSign2, 



U, 

35]; 

{ divide } 

RegDef 

[uFloatComResult, 



u. 

37]; 

{ > 

RegDef 

[uPPsave, 



u. 

3C]; 


RegDef 

[uFloat, 



u, 

42]; 

{ AsFloat } 

RegDef 

[uSavelPLow, 



u, 

43]; 

{ to save the ipLow during float divide primitive} 

RegDef 

[uFloatPlus, 



u. 

44]; 

{ Float Add } 

RegDef 

[uSavoStackLow, 



u, 

44]; 

{ to save the stacklow during float divide primitive} 

RegDef 

[uNewValHI, 



u, 

4B]; 

{ Result of the floating point operatio nls stored -- 

RegDef 

[uNewValLo, 



u, 

4 C ]; 

{ Result of the floating point operation is stored,— 

RegDef [uFloatMinus, 



u, 

66]; 

{ Float Subtract : A-B} 

RegDef [uSaveilomeLow, 



u. 

66]; 

{ to save the homeLow during float divide primitive} 

RegDef 

[uFloatMode, 



u. 

68]; 

{> 

RegDef 

[uArg2Hi, 



u. 

SC]; 

{j 

RegDef 

[uArg2Lo, 



u, 

60]; 

{> 


High half } 
Low half } 


RegDef [uFloatMultiply, 
RegDef [uFloatFix, 


U, 60]; { Multiply} 

U. 63]; { } 


{Process:} 

{Ureg definitions} 

RegDef[uVeryTempl, U, 26]; 
RegDef[uVeryTenip2, U, 27]; 
RegDef[ustack, U, 14]; 
RegDef[uhome, U, 17]; 


{+++++ Microcode subroutine return link definitions +++++} 


{It would be nice if Mass allowed one to define names for L registers, but It doesn't.} 

{ 

Link registers are used as follows: 

L0 tracks the number of bytecodes to back up the PC when a bytecode falls 
and is return link for fetchContextRegisters and stabilize. 

LI is the return link for otMap, otMap2, otMapBankO, arithmetic primitives, 

refl, refd, getDeltaWord, returnTopOfStack, transferWords, getTos, getSmashTos, 
addToFreeChunkList, and is used in conditional branch bytecodes. 

L2 Is the return link for getClass, getNewMethodHeader, lastPointerOf, 
addToZeroCountTable, nextFreeChunk, primRefi, and fIxedFleldsOf. 

L3 is the return link for primitives, makeVolatile, deallocate, 
and is set to zero at each bytecode dispatch. 


{ 

It would be nice If Mass macros could appear on the left side of «- clauses, but they can’t, so we define some macros to keep track of the 
number of bytes to back up when an instruction fails} 
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MacroDef [backupIsOBytes, t.O +■ 0] 
MacroDef [backuplslByte , LO *■ 1] 
MacroDef [backupIs2Bytes, LO <- 2] 
MacroDef [backupIs3Bytes, LO <- 3] 


{ Definitions for otMap returns. LI Is the return link. } 


Set 

[gett IngSmalitalkState, 

0] 

Set 

[IsOopGettingSmal1talkState, 

1] 

Set 

[isSmal1GettingSmalltalkState, 

2] 

Set 

[pushingLIteralVariable, 

3] 

Set 

[gett ingClass, 

4] 

Sot 

[gettIngMethodBase, 

5] 

Set 

[makingVolatilo, 

6] 

Sot 

[primStringAt, 

n 

Set 

[methodSearch, 

81 

Set 

[messageDictionary, 

9] 

Set 

[methodArray, 

OA'J 

Set 

[methodflaseAfterLookup, 

0B 

Set 

[saveSuperclass, 

OC' 

Set 

[gctMeUiodClass, 

0D' 

Set 

[getSuperclass, 

0E] 

Set 

[storingLIteralVariable, 

OF] 


{ Definitions for otMap2 returns. LI is the return link. } 


Set [gottingNextFreeChunk, 

Se.t [recoivcrDuringFotch, 

Set [methodDuringFetch, 

Set [gettIngActIveContextDuring luterpreterSwap, 
Set [getSenderBaso, 

Set [chasIngContextChaln, 

Set [inval IdatingContext, 

Set [gettingSpeclalSelectors, 

Set [ instanceSpoc, 

Set [splIcingBigFreeLlst, 

Set [stabilizing, 

Set [sweep ingObject, 

Set [largelntegerResult, 

Set [blockCopyOfBlock, 

Set [countBitsLargelnt, 

Set [nextInstance, 


0 ] 

1] 

2 ] 

3] 

4] 

5] 

6] 

7] 

8 ] 
8] 

OA] 

OB] 

OC] 

OD] 

OE] 

OF] 


(Defs for otMap3~return) 

Set[mapp1ngScheduler, 0]; 
Sot[mapp1ngProcessor, 1]; 
Set[mappIngProcessLists, 2]; 
Set[mappiugHighestPriorlty, 3J; 
Set[removingLink, 4]; 
Set[tnapp1ngLastLink, 5]; 
SetfaddingLink, 6]; 

$et[mappIngActProc, 7]; 
Set[mappingNewProc, 8]; 
Set[mappingActProcResume, 9]; 
Set[tnappingResumeProcess, Oaj; 
SetfmappingResumeProcLists, Ob]; 
SetfmappIngSleepLIst, Oc]; 
Set[mapp1ngPostponeList, OdJ; 


{ Definitions for otMapBankO returns. LI is the return link. } 


Set [gettingClassBankO, 0] 
Set [getFloatRecelver, 1] 
Sot [floatReturn, 2] 
Set [getUnaryFloatRecelver, 3] 
Set [getTImesTwoPowerRecelver, 8] 
Set [makelnstLargelnt, 9] 


{ Definitions for otMaplBankO returns. LI Is the return link. } 


Set 

[getParameterAfterMInt, 

0]i 

Set 

[getDestMapAfterMInt, 

1]! 

Set 

[getHalftoneBItsAfterMInt, 

2]; 

Set 

[getHalftoneBitsAfterMIntl, 

33; 

Set 

[getParameter, 

«]; 

Set 

[getSFormWH, 

«]: 

Set 

[getHalftoneBIts, 

6]; 

Set 

[getHalftoneBItsl, 

7]; 

Set 

[getCursorMap, 

«]: 

Set 

[getMap, 

»]: 

Set 

[getMapBase, 

0A] 


{ Definitions for getOtAddress and putOtAddress returns. LI Is the return link. } 

Set [splittlngFreeChunk, 0]; 

Set [countingOops, 1]; 

Set [compactorCreateFreeChunk, 9]*, 

Set [countingWords, OA]; 
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{ Definitions for getOtFlags and putOtFlags returns. Temp2High is the return link. } 


{splittingFreeChunk, 

Set [newQbjectMeader, 

Set [doingNormalRef1, 

Set [addingToZct, 

Set [volatizing. 

Sot [deallocating, 

Set [doingSpecialRefd, 

Set [returningToPool, 

{compactorCreateFreeChunk, 
{coun tingWords, 

Set [doingNormalRefcl2, 

Set [do ingNo final Ref d. 


0 } 

1 ] ; 

2 ], 

4] ; 

5] ; 

6 ] ; 

7]; 

S3; 

9> 

0A} 

OD]; (must be odd for skipRefd ??} 

OF]; {must be odd for skipRefd} 


{ Definitions for convort2Sinal 1 Integers 

returns. LI is 

bytecodes. } 



Set [smallLess, 

23: 

{bytecode} 

Set [smallGroater, 

3]; 

{bytecode} 

Set [smal1LessOrEqual, 

43; 

{bytecode} 

Sot [smallGreaterEqual 

6]; 

{bytecode} 

Set [smallMultiply, 

83; 

{bytecode} 

Set [smalIDivide, 

93: 

{bytecode} 

Set [smallMod, 

0A]; 

{bytecode} 

Set [smallMakePoint, 

0B]; 

{bytecode} 

Set [smallBltShift, 

0C]; 

{bytecode} 

Set [smallDiv, 

OD]; 

{bytecode} 

Sot [smallQuo, 

0E]; 


the return link and the SpecialSeleotors 


index for primitives that are also 


{ Definitions for primitiveTost2SmallIntegers returns. LI is the return link and the SpecialSelectors index for primitives that are also 
bytecodes. > 


Set [smallAdd, 

o]; 

{bytecode} 

Set [smallSubtract, 

i]: 

{bytecode} 

Set [small Equal, 

a]; 

{bytecode} 

Set [smal1NotEqual, 

7]; 

{bytecode} 

Set [smallBltXor, 

8]; 


Set [smal1B1tAnd, 

0E]; 

{bytecode} 

Set [smallBitOr, 

OF]; 

{bytecodo} 


{definitions for getClass return links. L2 is the return link register} 
(these constants are used in bank 1 } 

Set [primitiveClass, 0]; 

Set [poslBBit, 1]; 

Set [startingOeallocate, 2]; 

Sot [dlrectBlockCopy, 3]; 

Set [directValue, 4]; 

Set [prlmStringAtPut, 6]; 

Set [gettingNewReceiversClass, 6]; 

Set [superclassReceiver, 7]; 

Set [primitivePerform, 8]; 

Set [lookingForlnstances, 9]; 


{definition for getClassBankO return links. L2 
{these constants are used in bank 0 } 

Set [primNeeds2LargeIntegersl, 0]; 

Set [primNeeds2LargeIntegers2, 1]; 

Set [getFloatClass, 2]; 

Set [fetch2WordVal, 3]; 

Set [fetch2WordValPos, 4]j 


is the return link register } 

{ for Largelnteger } 

{ for Largelnteger } 

{ for Floating Point } 

{ for Largelnteger } 

{ for Largelnteger } 


{definitions for getNewMethodHeader return links. L2 is the return link register} 
Set [foundViaCache, 0]; 

Set [foundViaLookup, 1]; 

Set [gettingSuperclass, 2]; 


{definitions for conditional branch bytecodes} 
Set [branchlfTrue, 1 ]; 

Set [branchlfFalse, 0]; 


{definitions for refl. LI is the return link register} 


Set [popAndStoreRecVariable, 
Set [InMakeVolatlle, 


Set 

Set 

Set 

Set 

Set 

Set 


upClassAtInstanti at ion, 
primitiveRefl, 
changingActiveContext, 
correcting, 
storingLitVar, 
upNewSmalIContext, 


Set [viaPrlmitiveAtPut. 


0 ]; 

1] ; 

2] i 

33 : 

* 3 : 

63 : 

63 : 

? 3 : 

OC]; 


Set[addF1rstN11, 8]; 
Set[addLast, 9]; 
Set[bumpL1nk, 0a]; 
Set[bumpMyL1st, 0b]; 

{skip 0c} 

Set [newActContext, Od]; 
Set [prlmResumeRefl, Oej; 
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Lions for refd. LI is the return link 

register} 


{popAndStoreRecVariable, 

0} 


{InMakeVolatile, 

»} 

Set 

[pushingActiveContext, 

z]; 


{unusable because of a DRANCH 

3} 


{changIngActiveContext, 

4} 

Set [downOlcJContextOnReturn, 

S]i 


{storingLitVar, 

6} 

Set 

[nextContext, 

U: 

Set 

[newLargoContextSmashLeaf, 

8]; 

Set 

[downOldLeafContext, 

9]: 

Set 

[ viaPrimit i veVal ue, 

0A]; 


{unusable because of a BRANCH 

08} 


{viaPrimitIveAtPut, 

0C} 


Set[removoFIrstLInk, Od]; 

SetfdebumpLast, Oe]; 

Set[dGbumpMyList, Of]; 

{definitions for refd2Return, LI Is the return linkage register} 
Set[trnnsferingTo, 0]; 

SetfoldActContext, X]; 

Set[oldActProc, 2]; 

Set[*sleepinglt, 3]; 

Set[postponingIt, 4]; 


(definitions for getDeltaWord. Li is the return link register} 
{popAndStoreRecVariable, 0} 


{definitions for retuniTopOfStack. LI is the return link register} 
{popAndStoreRecVariable, 0} 

{storingLitVar, 6} 

Set [storoTemporary, OF]; 


{definitions for addToZeroCountTable. L2 is the return link register} 
{inMakeVolatile, 1} 

Set [creatingAnlnstance, 2]; 

{unusable because of a BRANCH 4} 

Set [doingRefd, 5]; 

Set[doingRefd2, 7]; 


{definitions for rnakeVolatile, uMakeVolatileLinkage is the return link register, odd ~> no rofd of context fields, even -> refd of 
context fields} 


Set 

[makeNewContoxtVol atile, 

0]: 

Set 

[fetchingContextRegisters, 

1]: 

Set 

[blockCopying, 

2]; 

Set 

[home, 

3]: 

Set 

[primValue, 

8]; 

Set 

[activeAfterStabtl Ize, 

73; 

Set 

[homeAfterStabilize, 

9]; 

Set 

[leafAfterStabilize. 

OB] 

Set[switchingProcs, Od]; 



{definitions for TastPointerOf. L2 is the return link register} 
Set [stabillzingContext, 1]; 

Set [getObjectEndForFreeing, 2]; 


{definitions for transferWords. LI Is the return link register} 
Set [activatingMove, 0]; 

Set [primitiveValue, 1]; 

Set [performPrim, 2j; 


{definitions for fetchContextRegisters. LO is the return link register} 
Set [newContext, 0]; 

Set [returningToAContext, 1]; 


{definitions for nextFreeChunk. L2 Is the return link register} 
Set [creatInglnstance, 0]; 

Set [consideringBigChunks, 1]; 


{ definitions for creating Instances. temp3High is the return link register} 
{ these constants are for Rum microcode in bank 1 } 

Set [makeBigContext, 0]; 

Set [makeSmallContext, 1]; 

Set (viaPrlmitiveNew, 2]; 

Set [viaPrimitiveMakePoint, 3]; 

Set [viaBlockCopy, 4]; 

Set [twoByteLargelnteger, 5]; 

Set [countBitsMakelnt, 6]; 

Set [bankPlugCreatelnstance, 7]; 

Set [primitiveMousePoint, 8]; 


{ these constants are for Rum microcode In bank 0 -- extra rum microcode } 
Set [creatIngFloatlnstance, 0]; { for Floating Point } 
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Set [makeObjectLargelnt, 


{definitions for posItlvelCBitValueOf. 
Set [primltiveObjectAt, 

Set [primitlveNew, 

Set [primit 1 veAt, 

Set [primitlveAtPut, 

Set [primitiveStringAt, 

Set [primitiveStringAtPut, 

Set [primitiveinstVarAt, 

Set [primitiveAsObject, 


{definitions for fixedFieldsOf. 1.2 
Set [newPrimltive, 0] 

Se t [cl assInPr imAt, 1] 

Set [forSIzePrim, 2] 

Set [forlnstVarAtPrlm, 3] 


1]; { for Largelnteger } 


tempSHigh Is the return link register} 
0 ]: 
i]i 


is tho return link register} 


(link definitions for getTos. LI is the return link register} 

Sot [makePoint, 0]; 

{link definitions for gotSmashTos. LI Is the return link register} 
{makePoint, 0} 


(link definitions for primRefi. 1.2 is the return link register} 
Set [upY, 0]; 

Set [upX, I]; 


{link definitions for addToFreeChunkList. LI is the return link register} 
Set [movoFroitiBigToSmal 1, 0]; 

Set [froeNonPointerObject, 1]; 

Set [nowDoneWithObjoct, 2]; 

{compactorCreateFreeChunk, 9} 


{Definitions for newFreeChunk. LQ is tho return link.} 


Set 

[remainderFreo, 

0] 

Set 

[carveFreei, 

n 

Sot 

[carveFroe2, 

2] 

Set 

[carveFree3, 

3] 


{link definitions for deallocate. 13 is the return link register} 
Set [fromStabil ize, 0]; 


{llnkge definitions for stabilize. L0 is tho return link register} 
Set [mesaRequestedStabilizatlon, 0]; 

Set [uCodeRequestedStabilization, 1]; 


{link definitions for getObjectSize. L3 is the return link register} 
Set [atPrim, 0]; 

Set [atPutPrim, 1]; 

Set [stringAtPrlm, 2]; 

Set [stringAtPutPrlm, 3]; 

Set [slzePrim, 4]; 

Set [InstVarAtPrim, 5]; 

Set [countBitsPrim, 6]; 


{link definitions for oetByteOrAddress. L2 is the return link register} 
{atPrim, 0} 

{stringAtPrim, 2} 

{stringAtPutPrlm, 3} 

{link constant for small integer multiply} 

Set [smalIPlusMultiply, 0]; 

Set [smallMinusMultiply, 1]; 

(link constant for small integer divide} 

Set [smallPlusDivide, 0]; 

Set [smallMinusDivide, 1]; 

{link constant for small integer mod} 

Set [smallModtemp3LowIsPlus0ISPlus, 4]; 

Set [smallModtemp3LowIsPlusQISMinus, 6]; 

Set [smallModtemp3LowIsMinusQISPlus , 6}; 

Set [smallModtemp3LowIsMinusQISM1nus, 7]; 

{link constant for smalllnteger dlv} 

Set [smalIPlusDIv, 2]; 

Set [smallMlnusDIv, 3]; 

{link constant for smalllnteger quo:} 

Set [smallQuoResultPlus, 8]; 

Set [smallQuoResultMlnus, 9]; 
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(qFetchByte2 subroutine return linkage, LI is linkage register} 


Set 

[wordValuels48yte0. 

0] 

Set 

[wordValueIs4Bytel, 

1] 

Set 

[wordValue!s4Byte2, 

2] 

Set 

[wordValueIs4Byte3, 

3] 

Set 

[wo rdValueIs4Byto0Pos, 

4] 

Set 

[wordValue!s4BytelPos, 

5] 

Set 

[wordValueIs4Byte2Pos, 

6] 

Set 

[wordValue!s4Byte3Pos, 

n 


{fetchByteLength subroutine return linkage, L2 is linkage register} 
Set [get2word, 0]; 

Set [get2wordPos, 1]; 

{fetch2WordVaUiePos subroutine return linkage, L3 Is linkage register} 
Set [largePosAddArgument, 0]; 

Set [largePosSubArgument, 1]; 

Set [largePosMulArgument, 2 ]; 

Set [largePosOivArgument, 3j; 

Set [largePosModArgument, 4]; 

Set [largePosDivideArgumont, 5]; 

Set [largePosCompareArgument, 6]; 

{fetch2WordValue subroutine return linkage, 1.3 is linkage register} 

Set [largePosAddRecoiver, 0]; 

Set [largePosSubReceiver, 1]; 

Set [largePosMulReceiver, 2]; 

Set [largePosDivReceiver, 3J; 

Set [largePosModRoceiver, 4]; 

Set [largePosDivideRecelver, 5j; 

Set [largePosAndArgument, 6]; 

Set [largePosAndReceiver, /]; 

Set [largePosOrArgument, 8]; 

Set [largePosOrRoceiver, 0]; 

Set [largePosXorArgument, 0A]; 

Set [largoPosXorRecolver, OB]; 

Set [1argePosCompareRoceiver, OCj; 

Set [largePosB i tShiftReceiver, 0D]; 


{compareLargelnteger subroutine return linkage. 
Set [primLargeLess, 0]; 

Set [primLargeGreater, 1]; 

Set [primLargeLessEqual, 2]; 

Set [primLargeGreaterEqual, 3]; 

Set [primLargeEqual, 4]; 

Set [prlml.argeNotEqual, 6]; 


L3 is linkage register} 


{MulfiplySubForLargelnt subroutine return linkage, LI is linkage register} 


Set 

[mulLowLow, 

0] 

Set 

[mulLowHigh, 

1] 

Set [mulHIghLow, 

2] 

Set 

[mu111 igliHigh 

3] 


{D1vide4byte SubForLargelnt subroutine return linkage, L3 Is linkage register} 
Set [prim4ByteDiv, 0]; 

Set [prim4ByteMod, 1]; 

Set [prim4ByteD1vide, 2j; 


{ floating point constant *Float*} 
Set [unaryMessage, 

Set [binaryMessage, 


Set 

Set 

Set 

Set 

Set 

Set 

Set 

Set 

Set 

Set 

Set 

Set 

Set 

Set 

Set 

Set 


[asFl oat, 

[floatAdd, 
f loatTruncated, 
floatSub, 
f loatFractional, 
^floatLessThan, 

;floatExponent, 
floatGreaterThan, 

;rn.pi.ieee, 

[floatTwoTimes, 

[floatLessOrEqual, 
tfloatGreaterOrEqual, 
[floatEqual, 
[floatNotEqual, 
[floatMultiply, 
[floatDivide, 


{ for fptDivideLoop } 

Set [L3.d1v1del, 
Set [L3.div1de2, 


0]; {float divide } 
1]; {float divide } 


{ for deNorm } 

Set [L3.rePackl, 


0]; {float divide } 


{ for checkFloatType ----} 

Set [Ll.checkResultType 
Set [Ll.checklnfinlty, 
Set [Ll.checklnfinityl, 
Set [LI.checkReceiver, 
Set [LI.checkArgument, 


0]; {float compare} 

1] ; {float Compare} 

2] ; (float Compare} 

3] : {float Divide} 

4J; {float Divide} 
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{ for floatCornpare subroutine } 

Set [L2.floatUessThan, 

Set [L2.floatGreaterThan, 

Set [L2.floatLess0rEqual, 

Set [ L2. f loatG reatorQrEqual, 
Set [1.2.f loatEqual, 

Set [12.floatNotEqual, 


Set [floatZero, 0]; 
Set [floatNormal, l]; 
Set [floatlnfInlty, 2]; 
Set [floatNan, 3], 


{Defs for act 1 veProc-ret} 
Set[pr1mWaitAP, 0]; 
Set[actProcCbockProc, 1]; 
Set[primSuspendAP, 2]; 

Set[resumeActProc, 33; 
Set[actProcChcckProc, 4]; 

(Defs for rcmoveFIrst-ret) 

Set[wakingHighest, O'J; 
Set[pr1mS1gnalRemove, t]; 

{Defs for addFIrstOrLast-ret} 
Set[primWa1tAdd, O'J; 
Set[sleepAddLast, ij; 
Set[postponeAddFirst, 2 J; 

{Defs for schedPtr-ret} 

Set[suspondActIveSPtr, 0]; 
Sot[resumeSPtr, l]; 
Set[act1veProcSPtr, 2]; 


{ 

{ 

{ 

{ 


for floarcomapre, 
for floatcompare, 
for floatcompare, 
for floatcompare, 


=Float=} 

=F1oat B } 

=Float-} 

3 Float=} 


Debugging definitions +++++} 

Set [debug, 1]; 

Set [noDebug, 0]; 

Set [debugTraps, debug]; 

Set [bankOError, 

0]i 

Set 

[rofdZero, 

l]; 

Set 

[specialRefdZero, 

2]; 

Set 

[primltlveO, 

3]; 

Set 

[atPutlnstError, 

4]; 

Set 

[sizelnstError, 

6]; 

Set 

[pushLiteralLambda, 

*]; 

Set 

[trapAtLocatlonO, 

?3; 

Set 

[otMapSmal1 Integer, 

8]; 

Set 

[otMap2Smal1Integer, 

93: 

Set 

[otMap3SmallInteger, 

OA] 

Set 

[tooManyOops, 

OB] 

Set 

[classIsLambda, 

0C] 

Set 

[superclassis Lambda, 

00] 

Set 

[impossiblePurposeOl, 

0E] 

Set 

[ImpossIblePurposelO, 

OF] 

Set 

[ImpossIbleClass, 

10] 

Set 

[ImpossIbleSIzel, 

11] 

Set 

[1mposs1bleS1ze2, 

12] 

Set 

[ImpossIbleLInk, 

13] 

Set 

[otMapBankOSmallInteger, 

14] 

Set 

[otMaplBankOSmal1Integer, 

16] 

Set 

[trapAtLocationOBankO, 

16] 

Set 

[ refCountZero, 

12] 

Set 

[ refd2Zero, 

18] 


{+++++ Smalltalk-80 object definitions +++++} 


Set [notMlnusOnePoInter, 

3] 

Set [zeroPoInter, 

0] 

Set [onePointer, 

4] 

Set [twoPointer, 

8] 

Set [lambdaPoInter, 

1] 

Set [nllPointer, 

3] 

Set [falsePointer, 

6] 
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} 


{ 


} 


{ 

} 

{ 

} 

Ruin, dfn 


Sat [truePointer, 

Set [schedulers soci at Ion Pointer, 

Set [classSmall IntegorPoInter, 

Set [classStrlngPointer, 

Set [classArrayPointor, 

Set [classFloatPointer, 

Set [methodContoxtClassOop, 

Set [blockContoxtClassOop, 

Set [classPointPointer, 

Set [classLargePositiveIntege('Pointer, 
Set [classMessagePointer, 

Set [classCompiledMethodQop, 

Set [classCharacterOop, 

Set [doesNotUnderstandSelector, 

Sot [cannotHeturnSelector, 

Set [speclalSelectorsOop, 

Set [characterTableOop, 

Sot [mustOcBooleanSelector, 


7]; 

9]; 

OD] 

OF] 

11 ] 

15] 

17 ] 

19] 

IB] 

ID] 

21 ] 

23] 

29] 

2B] 

2D] 

31] 

33] 

35] 


Object table entry format: 



even word: 

address 

In bank 




odd word: 

rrrr rrzo bppu bbbb 





r: 

FC00 

reference count 




z: 

200 

in zero count table 



o: 

100 

in overflow 

table (Loon 



b: 

8F 

bank address 




p: 

60 

purpose bits (60: 

: free 



u: 

10 

untouched 



Set 

[purposoBIts, 

60]; 





Set 

[freeOop, 

60]; 





Set 

[inUse, 

0]; 





Set 

[inZctRot8, 

2]; 

{must 

be rotated to 

high 

byte) 

Set 

[refCountRot8, 

0FC]; 

{must 

be rotated to 

high 

byte) 

Set 

[refPlus0neRot8, 

4 3s 

{must 

be rotated to 

high 

byte) 

Set 

[refMinusO»eRot8, 

0FC]; 

{must 

be rotated to 

high 

byte) 

Object delta word format: 






dddd dddd uuuc 

Ivop 







d: FF00 

delta count (Loom) 


u: 

E0 

unused 


c: 

10 

clean 


1: 

8 

contains lambda 


v: 

4 

volatile 


01 

2 

odd bytes 


p: 

1 

pointers 

Set 

[evonBytes, 


0]i 

Set 

[hasWords. 


0]: 

Set 

[hasPoInters, 


i]i 

Set 

[oddBytes, 


2]! 

Set 

[volatlleBIt, 


4]; 


Stretch format compiledMethod header: 
ffft tttt 1111 1100 


f 

t 

1 

0 


E000 flag field 

1F00 temporary count 

FC literal count 

3 smalllnteger tag 


Stretch format compiledMethod header extension: 
baaa aapp pppp ppOO 


b 

a 

P 

0 


8000 big context flag 

7C00 argument count 

3FC primitive Index 

3 smalllnteger tag 
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{ 


Stretch format class instance specification: 


} 


pwif ffff ffff ffOO 


P 

W 

I 

F 

0 


8000 pointers flag 

4000 words flag 

2000 indexable flag 

1FFC fixed field count 

3 small Integer tag 


Set 

[twoBytelnteger, 

2]; 

Set 

[threeByteInteger, 

3.1; 

Set 

[fourBytelnteger, 

i]: 

Set 

[freeBlockMark, 

0]; 

Set 

[notAnObjectRotl, 

1]; 


{definitions for size of the Object Header and fields within objects} 


Sot [objectHeaderSIze, 3]; 

Set [twicoObjectHoaderSize, Mul[2, objectHaadorSize]]; 

Sot [twIceObjectHoaderSizeLessOne, Sub [twiceObjectHeaderSizo, 1]]; 


Set [tempFramoSturt, 6]; 


Sot [stackPoInterAdjustmentFactor, Sub [Add [objectHeaderSIze, tempFrameStart], 1]]; 

Set [largoContextSIzelessObjectHeader, Add [32'd, tempFrameStart]]; 

Set [smallContextSizeLessObjectHeader, Add [12'd, tempFrameStart]]; 


Set [fleldO, 
Set [fieldl. 
Set [fleid2, 
Set [field3, 
Set [f1eld4. 
Set [fields. 
Set [field6, 
Set [fIeld7, 
Set [fields, 
Set [f1eld9, 
Set [fieldlO, 
Set [fieldll. 
Set [f1eldl2, 
Set [f1eldl3, 
Set [f1eldl4, 
Set [fieldlS, 


Add [ 0, 
Add [ 1, 
Add [ 2, 
Add [ 3, 
Add [ 4, 
Add [ 6, 
Add [ 6, 
Add [ 7. 
Add [ 8, 
Add [ 9, 
Add [OA, 
Add [OB, 
Add [OC, 
Add [OD, 
Add [OE, 
Add [OF, 


objectHeaderSIze]] 

objectHeaderSIze]] 

objectHeaderSIze]] 

objectHeaderSizej] 

objectHeaderSIze] - 

objectHeaderSIze' 

objectHeaderSIze" 

objectHeaderSIze] 

objectHeaderSIze] 

objectHeaderSIze]] 

objectHeaderSIze]] 

objectHeaderSizej] 

objectHeaderSIze]] 

objectHeaderSIze]] 

objectHeaderSIze]] 

objectHeaderSIze] - 


{Instance variable offsets Into objects) 


Set[processNextLink, 
SetfprocessSuspendedContext, 
Set[proces$Priority, 

Set[p rocessMyLlst, 

Set[semaphoreF1rstL1nk, 
Set[semaphoreLastL1nk, 
Set[semaphoreExcessSignals, 


Add[objectHeaderS1ze,0]]; 
Add[objectHeaderSize,1]]; 
Add[objectHeaderS1ze,2]]; 
Add[objectHeaderSIze,3]]; 

Add[objectHeaderSize.O]]; 
AddfobjectHeaderSize.l]]; 
Add[objectHeaderSIze,2]]; 


Set[schedulerProcessLists, Add[objectHeaderS1ze,0]]; 

Set[schedulerAct1veProcess, AddfobjectHeaderSIze, 1 ]]; 


Set[assoclat IonKey, Add[objectHeaderS1ze,0]]; 

SetfassoclatlonValue, AddfobjectHeaderSIze,1]]; 

Set[schedulerAsso1cationPoInter, 8]; 
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{definitions for temporaries within Contexts} 


Set [tempo, Add [ 0, 
Set [tempi, Add [ 1, 
Set [temp2, Add [ 2, 
Set [teinp3, Add [ 3, 
Set [temp4. Add [ 4, 
Set [tempB, Add [ 5, 
Set [tempo, Add [ 6, 
Set [temp7, Add [ 7, 
Set [temp8. Add [ 8, 
Set [temp9, Add [ 9, 
Set [templO, Add [0A, 
Set [temp 11, Add [GB, 
Sot [temp 12, Add [OC, 
Set [templ3, Add [0D, 
Set [templ4, Add [0£, 
Set [templS, Add [OF, 


tempFrameStart, objectHeaderSize]]; 
tempFrameStart, objectHeaderSize]]; 
tempFrameStart, objectHeaderSize]]; 
tempFrameStart, objectHeaderSize]]; 
tempFrameStart, objectHeaderSize]]; 
tempF rameStart, objoctHeade rSize]]; 
tempFrameStart, objectHeaderSize]]; 
tempFrameStart, objectHeaderSize]]; 
tempFrameStart, ObjectHeaderSize]]; 
tempFrameStart, objectHeaderSize]]; 
tempF rameStart, objec tHeado rSizo]]; 
tempFrameStart, objectHeaderSize]]; 
tempF rameStart, objectHeaderSize]]; 
tempFrameStart, objectHeaderSize]]; 
tempFrameStart, objectHeaderSize]]; 
tempFrameStart, objectHeaderSize]]; 


{definitions for Literal fields in CompiledMethods} 
Set [literal Start, 1]; 


Set 

[llteralFieldO, 

Add 

[ 0, 

Set 

[1 iteralFieldl, 

Add 

[ 1. 

Set 

[11tera1F1e1d2, 

Add 

[ 2. 

Set 

[1 iteralField3, 

Add 

C 3, 

Set 

[1itoralField4, 

Add 

[ 4, 

Set 

[11 teralField5, 

Add 

[ 6. 

Set 

[literalFieldG, 

Add 

[ 6, 

Set 

[litoralF1old7, 

Add 

[ 

Set 

[literalField8, 

Add 

[ 8, 

Set 

[1iteralF1eld9, 

Add 

[ 9, 

Set 

[literalFieldlO, 

Add 

[0A, 

Set 

[literalFieldll, 

Add 

[OB, 

Set 

[1iteralFieldl2, 

Add 

[0C, 

Set 

[literalF1oldl3, 

Add 

[0D, 

Set 

[1 iteral Fie Id 14, 

Add 

[0E, 

Set 

[1iteralFieldl6, 

Add 

[OF, 

Set 

[1IteralFiel die, 

Add 

[10, 

Set 

[lite ralFieldl7, 

Add 

[11. 

Set 

[literalFio1dt8, 

Add 

[12. 

Set 

[literalF1eldl9, 

Add ; 

[13, 

Set 

[literalField20, 

Add ; 

[14. 

Set 

[1IteralF1eld21, 

Add | 

'15, 

Set 

[literalField22, 

Add 

: 16, 

Set 

[1iteralField23, 

Add 

'17, 

Set 

[1itoralField24, 

Add 

18, 

Set 

[1iteralField25, 

Add 

19, 

Set 

[11teralF1eld26, 

Add 

1A, 

Set 

[11teralField27, 

Add [IB, 

Set 

[11teralField28, 

Add [1C, 

Set 

[literalF1eld29, 

Add [ID, 

Set 

[1iteralField30, 

Add [IE, 

Set 

[literalField31, 

Add [IF, 


I iteralStart, 
1 iteralStart, 
1 itoralStart, 
1 itoralStart, 
1 iteralStart, 
1 itoralStart, 
1 iteralStart, 
1 iteralStart, 
1 iteralStart, 
1 iteralStart, 
1 iteralStart, 
1 iteralStart, 
1 iteralStart, 
1 iteralStart, 
1 iteralStart, 
1 iteralStart, 
1 IteralStart, 
1 iteralStart, 
1 iteralStart, 
1iteralStart, 
1 iteralStart, 
1 iteralStart, 
1iteralStart, 
1 iteralStart, 
1iteralStart, 
1iteralStart, 
1iteralStart, 
1iteralStart, 
1iteralStart, 
1iteralStart, 
1iteralStart, 

1iteralStart, 


objectHeaderSize]] 

objectHeaderSize]] 

objectHeaderSize]] 

objec tHeaderSize]] 

objectHeaderSizej] 

objectHeaderSize]; 

objec tHeaderSize] 

objectHeaderSize]] 

objectHeaderSize]] 

objectHeaderSize]] 

objectHeaderSize]] 

objectHeaderSize]] 

objectHeaderSize]] 

objectHeaderSize]] 

objectHeaderSize]] 

objectHeaderSize]] 

objoctHeaderSize]] 

objectHeaderSize]] 

objectHeaderSize]] 

objectHeaderSize]] 

objectHeaderSize]] 

objectHeaderSize]; 

objectHeaderSize]; 

objectHeaderSize]] 

objectHeaderSize]] 

objectHeaderSize]] 

objectHeaderSize]] 

objectHeaderSize]] 

objectHeaderSize]] 

objectHeaderSize]] 

objectHeaderSize]] 

ObjectHeaderSize]] 


[Definitions for offsets Into objects} 

{Loom; certain offsets are Loom sensitive} 

Set [deltaWordOffset, 0]; 

Set [sizeFieldOffset, 1]; 

Set [classFieldOffset, 2]; 

Set [firstPointerFieldOfObject, classFleldOffset]; 

Set [firstFieldOfObject, Add [1, classFieldOffset]]; 

Set [sizeOfLargelntegerForPosit1vel6BitValueOf, Add [1, objectHeaderSize]]; 


Set [associationValuelndex {where values live in associations}, Add [1, objectHeaderSize]]; 


Set [messageDIctlonaryOffset, Add [1, objectHeaderSize]]; 

Set [InstanceSpecIfIcatlonFieldOffset, Add [2, objectHeaderSize]]; 

Set [selectorStart, 2]; 

Set [selectorStartPlusObjectHeaderSize, Add [selectorStart, objectHeaderSize]]; 
Set [superclassOffset, Add [0, objectHeaderSize]]; 

Set [chunklinkOffset, classFieldOffset]; 
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{fields of context objects} 

Set [senderFleldOffset, Add [0, 
Set [instructionPointerFleldOffset, Add [1, 
Set [stackPointerFieldOffset, Add [2, 
Set [methodFieldOffset, Add [3, 
Set [blockArgumentCountOffset, Add [3, 
Set [initialInstructionPointerOffset, Add [4, 
Set [recelverFieldOffset, Add [5, 


Set [homeFieldOffset, recelverFieldOffsetJ; 


objectHeaderSIze}}; 
objectHeaderSIze]]; 
objectHeaderSIzo]]; 
objectHeaderSIzo]J; 
objectHeaderSIze]]; 
objectHeaderSize]]; 
objectHeaderSize]]; 


Set [dlfferonceBetwoenSenderAndMethodFields, Sub[methoriFieldOffset, senderFieldOffsetJ]; 

Set [difforenceBetweenSeriderAndlnstructionPointerFields, 5ub[ ins tructlonPo InterF leldOf f set, senderFieldOf fset]]; 


Set [offsetFromDeltaWordioSizeFieId, 1]; 

Sot [offsatFromDeltaWordToClassFleld, 2]; 

Set [offsetFromSizeFlol dToClass Field, 1]; 

Set [ofFsetFromClassFieldToFirstField, 1]; 

Set [offsotFromlnstructionPoIntorToStackPointer. 
Sot [offsetFromStackPointerToArgCount, 

Set [offsetFromArgCountToInitlalIP, 

Set [offsetFromlnitialIPToHome, 

Set [offsetFromSenderToBlockArgCount, 

Set [offsetFromB1ockArgumentCountToFirstTemp, 

Set [offsetFromlnitiallpToIp, 

Set [of fsetFromlpToArgumentCount, 

Set [offsetFromlpToStackPointer, 

Sot [offsetFromSenderToStackPointer, 


i]; 

!]: 

1] i 

1 ]; 

3 ]: 

Sub [tempo, 
3]; 

2 ] 

1 ] 

2 ] 


blockArguinentCountOf fset]]; 


(known displacements within Points} 

Set [yFieldOffsetlnPoint, Add [1, objectHeaderSize]]; 
Set [offsetFromXFieldToYField, lj; 


{+++++ Main memory definitions +++++} 


Set [TargestFreeChunkSize, 45'd]; (largo contexts with up to four Loom words should fit a small free list} 

Set [largestFreeChunkSIzeLessOne, Sub [TargestFreeChunkSize, 1]]; 

Set [maxImumObjectSIze, 65484'd]; 

Set [objectSizeTestLImit, Sub [65635'd, maximumObjectSize]]; 

Set [otSIzeRot8, 0C0]; 


{ Offsets Into the Rum/Molasses communications record } 


Set 

[directiveOffset, 

0]; 

Set 

[activeContextOopOffset, 

i] 

Set 

[homeContextOopOffset, 

2] 

Set 

[rece1ve rOopOff set, 

3] 

Set 

[currentMethodOopOffset, 


Set 

[inst. ruct ionPoInterOf fset, 

6] 

Set 

[stackPointerLowOffset, 

6] 

Set 

[stackPoInterHIghOffset, 

O 

Set 

[newProcessWaltlngOffset, 

8] 

Set 

[newProcessOopOffset, 

93 

Set 

[leafContextOopOffset, 

0A] 

Set 

[zctLowOffset, 

OB] 

Set 

[zctHighOffset, 

OC] 

Set 

[zctlndexOffset, 

0D] 

Set 

[displayBitmapOopOff set, 

0E] 

Set 

[displayScreenOopOffset, 

OF] 

Set 

[cursorBitmapOopOffset, 

10] 

Set 

[objectTableLowOffset, 

»] 

Set 

[objectTableHighOffset, 

12] 


(never actually read nor written!}; 
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Set 

[objeclMemoryLowOffset, 

13] 

Set 

[objectMemoryHIghOffset, 

U] 

Set 

[objectMemoryAfterLowOffset, 

15] 

Set 

[objoctMemoryAfterHIghOffset, 

16] 

Set 

[methodCacheLowOffset, 

in 

Sot 

[methodCacheHighOffset, 

18] 

Set 

[stab 11 ization FlagOffset, 

19] 

Set 

[stabl 'l izat ionLimitOff set, 

1A] 

Set 

[oopLeveILowOffset, 

IB] 

Set 

[oopLevelHighOffset, 

1C] 

Set 

[oopAlcrtLevelLowOffset, 

ID] 

Set 

[oopAlertlove1HlghOffset, 

IE] 

Set 

[wordLevelLowOffset, 

IF] 

Set 

[wordlevelHighOffset, 

20] 

Set 

[wordAlertLovolLowOffset, 

21] 

Set 

[wordAlertLevolHighOffset, 

22] 

Set 

[alreadyAlortedOffset, 

23] 

Set 

[signalAlertOffset, 

24] 

Set 

[ iiiputBufforLocLow, 

25] 

Set 

[ InputBufforLocHIgh, 

23]; 

Set 

[ InputBuffe rSizo, 

22]: 

Set 

[ inputBufferln, 

28]; 

Set 

[inputOufferOut, 

29]; 

Set 

[primlt1veMapLowOffset, 

28] 1 

Set 

[prirni tlveMapll ighOf fset, 

2B]; 

Set 

[freoPointersOopOffset, 

2C]; 

Set 

[froeLlstsOffset, 

2D]; 

Set 

[bigFroelistOffset, 

Add 


[freeLlstsOffset, 


1argestF reeChunkSIza]]; 


{ Edit, history: 

30-Sep-85 17:10:47 
21-Mar-85 13:36:32 
point) 

16-Mar-86 18:64:20 
13-Mar~85 12:59:54 
28-Fet)-85 15:09:52 
21-Feb-85 14:21:44 
ll-Jan-85 10:01:46 
8-Jan-85 10:63:02 


Trow.pa convert to stretch format 

Tokunaga.fx add link for creatInstance, getClassBankO, otMapBankO, used In bank 0 (large integer, floating 


Udagawa.fx add create instance link for split Rum bank and comment out U3FFF, ulFFF, u7FF for bank 0 

Udagawa.fx mark used u-reg by . 

Udagawa.fx Klamath conversion, exchange U36, U2E 

Susser.pasa add InputBuffer stuff at the end of Rum communications record 

Susser.pasa add Set macro for large memory 

Udagawa.fx add Set macro for sendArithmeticMessage } 


Rum,dfn 
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{ MemoryManglement.me 


Object creation, reference counting, stabilization, and other memory management stuff for Rum, the Daybreak. Smalltalk-80 microcoded 
virtual machine. 

by P McCullough, J Trow, M Hoshino 
31-Jul-87 15:22:16 

Copyright 1983, 1984, 1985, 1986, 1987 by Xerox Corporation. All rights reserved. } 


{for each of these entry points, uClassToInstantiate must be the oop of the class, temp3Low is the size in words or bytes. temp3High is 
the return linkage register} 


createlnstanceWithPointers: 

temp2Low <- nilPointer, cl; 

templlow <- hasPointers, GOTO [createlnstance], c2; 

createlnstanceWithBytes: 

temp2Low «• 0, cl; 

[] «■ temp3Low LRotO, XOisp, c2; 

temp3Low *■ temp3Low + 1, BRANCH [$ , byteCountlsOdd, OE], c3; 

byteCountlsEven: 

templLow «- evenBytes, GOTO [byteShlft], cl; 

byteCountlsOdd: 

templLow «■ oddBytes, cl; 

byteShlft: 

temp3Low *■ RShlftl temp3Low, SE *• 0, GOTO [createlnstance], c2; 

createlnstanceWithWords: 

temp2Low «- 0, cl; 

templLow *■ hasWords, GOTO [createlnstance], c2; 

createLargePositivelnteger: 

templLow <- classLargePositivelntegerPointer, cl; 

uClassToInstantiate <- templLow. c2: 

GOTO [createlnstanceWithBytes] c3; 


{ createlnstance 

Create a new instance of a given class. 

input: templLow is the odd byte and pointer bits of the delta word 
temp2Low is the initial value of the fields of the instance 
temp3Low is the size of the instance in words not including the header 
uClassToInstantiate is the class of the new instance 
temp3High is the return link 

output: uNewObject is the new instance 

uNewObjectHigh/Low is the address of the new instance 
uRequestedSize is the size of the new instance 

smash: otLow, temp 1H igh/Low, temp2High/Low, temp3High/Low. Q, uPredecessor, uFieldType, uDefault, uCurrentFreeChunkOop, 

uNextFreeChunk, LI, L2, } 


createlnstance: 

uFieldType templLow 

{save these for initializing the object and its ot entry}, c3; 


uDefault «■ temp2Low, cl; 
temp3Low «- temp3low + objectHeaderSize. CarryBr. c2; 
Q *• objectSizeTestLimit, BRANCH [$, massiveSenil ity2] , c3; 

[] «- temp3Low + Q, CarryBr, cl; 
BRANCH [$, requestedSizeTooBig], c2; 
temp2High *■ uRumRecordHigh , c3; 

temp2Low *■ uRumRecordLow, cl; 
templLow «- largestFreeChunkSize , c2; 
[] *■ temp3Low - templLow, CarryBr, c3; 

uRequestedSize «■ temp3Low, BRANCH [$, useBIgFreeList], cl; 
temp2Low «- temp2Low + freeListsOffset, {try specific list} c2; 
Noop, c3: 


MAR «- [temp2High, temp2Low + temp3Low], 

CANCELBR [$, 0], 

otLow <- MO, L2 <- creatinglnstance {for nextFreeChunk}, 

Noop. 

Noop, 

[] «• otLow and 3. ZeroBr, 


cl: 
c2; 
c3; 
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cl; 
C2; 
c3: 


{temp} 



uNewObject «- otLow, BRANCH [$, tryBigList], 

LI «■ gettingNextFreeChunk {for otMap2 inside nextFreeChunk), 
CALL [nextFreeChunk], (got one) 

MAR <- [temp2High, temp2Low + temp3Low] (update free list head) 
MDR *■ Q, LOOPHOLE [wok], CANCELBR [$. 0], 

Q *■ templHigh, {save new object's address) 

uNewObjectHigh «- Q, 
uNewObjectLow «■ templLow, 

GOTO [allocate], 


cl; 

c2; 

cl, at [creatinglnstance, 10, nextFreeChunk-return]; 
c2; 
c3; 

cl; 
c2; 
c3; 


tryBigList: 

temp2Low «- uRumRecordLow, GOTO [useBigFreeListA], 


c2; 


{upon entry, temp2High/Low contains the rum record address. uRequestedSIze is valid. temp3Low is the requested size) 
useBigFreeList: 

Noop, c2; 

useBigFreeListA: 

uPredecessor «- 0 {should be nilPointer), 

LI *• gettingNextFreeChunk {for otmap call in nextFreeChunk), c3; 


MAR <- [temp2H1gh, temp2Low + bigFreeListOffset], 

L2 <- consider ingBigChunks , cl; 

temp3Low <- temp3Low + objectHeaderSize, CarryBr, 

{yields minimum splittable block size) CANCELBR [$, 0], c2; 

otLow «- MD {current free chunk), BRANCH [$, massiveSenl 1 ity4] , c3: 

considerNextBigFreeChunk: 

Noop, cl; 

Noop, c2: 

[] «■ otLow and 3, ZeroBr, c3; (temp) 

uNewObject <- otLow, BRANCH [$, outOfChunks], cl; 

uCurrentFreeChunkOop «- otLow, CALL [nextFreeChunk], c2; 


uNextFreeChunk «- Q {remember next free chunk), 
templLow «- templLow + sizeFieldOffset, 

Noop, 


cl, at [consideringBigChunks, 10, nextFreeChunk-return]; 
c2; 
c3; 


MAR <- [templHigh, templLow + 0], cl: 
Noop, c2; 
Q <- MD (size of current free chunk), c3; 

[] *- Q xor uRequestedSize, ZeroBr, cl; 
[] «• Q - temp3Low, CarryBr, BRANCH [S, exactFit], c2; 
BRANCH [$, canSubdlvide], c3: 

iterate: 

uPredecessor <- otLow, cl; 
Noop, c2; 
otLow *• uNextFreeChunk, GOTO [considerNextBigFreeChunk], c 3 ; 


exactFit: 

templLow «- templLow - sizeFieldOffset. CANCELBR [$, 1], c3; 

Q <- templHigh, cl; 

uNewObjectLow «- templLow, c2; 

uNewObjectHigh «■ Q, GOTO [splice], c3; 


canSubdivide: 

temp3Low «• uRequestedSize, cl; 

temp3Low (new size) *■ Q {current size) - temp3Low (requested size), c2; 

Q *■ templHigh (part of new object’s address), c3; 

MAR *• [tetnp2High, temp2Low + freePointersOopOffset], cl; 

uNewObjectHigh «■ Q, CANCELBR [$, 0], c2; 

otLow «■ MD (first free oop), c3; 

Noop, cl; 

Noop, c2; 

[] «■ otLow and 3, ZeroBr, c3; (temp) 

uNewObject «- otLow, BRANCH [$, outOfOops], cl; 

0 «- templLow - sizeFieldOffset, LI «■ spl ittlngFreeChunk, c2; 

Q {object address) «- Q (chunk address) + temp3Low (chunk size), c3; 


{write the new size of the current free chunk (templHigh/Low still pointing at its size field)) 


MAR <- [templHigh, templLow + 0], 

MDR «- temp3Low {new chunk size), 
uNewObjectLow <- Q, 

CALL [getOtAddress] {free oop link), 

MAR «- [ternp2High, temp2Low + f reePointersOopOffset], 

MDR <- templLow {new free oop head), LOOPHOLE [wok], CANCELBR 
temp2High *■ spl ittingFreeChunk, 

templLow *■ uNewObjectHigh. CALL [putOtFl ags] , 


cl; 
c2; 
c3; 

c 1; 

cl, at [splittingFreeChunk, 10, getAddressReturn]; 
[S, 0], c2; 

c3; 

c 1; 


2 
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{Adjust the memory and oop levels and signal Mesa if either Is below its alert level and Mesa has not yet been signalled, 
(({wordLevel < wordAlertLevel) or: [oopLevel < oopAlertLevel]) and: [alreadyAlerted = 0]) ifTrue: [slgnalAlert *■ 1. MesalntRq]} 


allocate: 

temp2High «■ uRumRecordHigh, cl; 
temp2Low <- uRumRecordLow, c2; 
Moop, c3; 

MAR *■ [temp2H1gh, temp2Low + oopLeve 1 LowOffset], cl; 
CANCELBR [$, 0], c2; 
temp3Low *• MD, c3; 

MAR *■ [temp2H1gh, temp2Low + oopLevelLowOffset], cl; 
MDR *■ temp3Low «- temp3Low - 1, LOOPHOLE [wok], CANCELBR [$, 0], c2; 
Noop, c3; 

lowOop Test: 

MAR «■ [temp2High, temp2Low + oopAlertLevelLowOffset] , cl; 
CANCELBR [$, 0], c2; 
Q <- MD, c3 ; 

Noop, cl; 
Q «• temp3Low - Q, CarryBr, c2; 
BRANCH [$, decreaseWordLevel], c3: 

MAR <- [temp2High, temp2Low + al readyAlertedOff set] , cl; 
CANCELBR [$, 0]. c2; 
Q ^ MD. c3; 
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[] «• Q, ZeroBr, cl 
BRANCH [decreaseWordLeve!2, $], c2 
Noop, c3 

MAR <- [temp2High, temp2Low + signalAlertOffset], cl 
MDR «- 1, LOOPHOLE [wok], CANCEL8R [$, 0], c2 
MesalntRq (run mesa before next bytecode), GOTO [decreaseWordLeve!], c3 


decreaseWordLeve!2: 

Noop, c3 
decreaseWordLeve!: 

MAR [temp2H1gh, temp2Low + wordLevelLowOffset], cl 
temp3Low *■ uRequestedSlze, CANCELBR [$, 0], c2 
Q <- MD, c3 

MAR [temp2High, temp2Low + wordLevelLowOffset], cl 
MDR «■ temp3Low *■ Q - temp3Low, CarryBr, LOOPHOLE [wok], 

CANCELBR [$, 0], c2 
BRANCH [$, 1owMemoryTestHighGetData], c3 

wordLevelBorrow: 

MAR *■ [temp2High, temp2Low + wordLevelHighOffset], cl 
CANCELBR [$, 0], c2 
Q «• MD, C 3 

MAR «■ [temp2High, temp2Low + wordLevelHighOffset], cl 
MDR * Q - 1, LOOPHOLE [wok], CANCELBR [$. 0], c2 
templLow *■ Q - 1 , GOTO [lowMemoryTestHighHaveData], c3 

1owMemoryTestHighGetData: 

MAR «- [temp2High, temp2Low + wordLevelHighOffset] . cl 
CANCELBR [$, 0], c2 
templLow <- MD, c3 

lowMemoryTestHighHaveData: 

MAR *■ [temp2High, temp2Low + wordAlertLevelHighOffset] , cl 
CANCELBR [$, 0], c2 
Q *■ MD. c3 

Q *■ Q - templLow, CarryBr, cl 
[] «- Q, ZeroBr, BRANCH [rea'llyAl locatel, $], c2 
BRANCH [$, lowMemoryTestLow], c3 

MAR «- [temp2High, temp2Low + alreadyAIertedOffset], cl 
CANCELBR [$, 0], c2 
Q ^ MD, c3 

[] «- Q, ZeroBr, cl 
BRANCH [1owMemoryTestLow2, $], c2 
Noop, c3 

MAR *• [temp2High, temp2Low + signalAlertOffset], cl 
MDR <r 1, LOOPHOLE [wok], CANCELBR [$, 0], c2 
MesalntRq (run mesa before next bytecode), GOTO [reallyAl1ocate3], c3 


lowMemoryfestLow2: 

Noop, c3 
lowMemoryTestLow: 

MAR *■ [temp2H1gh, temp2Low + wordAlertLevelLowOffset], cl 
CANCELBR [$, 0], c2 
Q MD, c3 

Noop, cl 
Q «* temp3Low - Q, CarryBr, c2 
BRANCH [$, reallyAllocate3], c3 

MAR «- [temp2High, temp2Low + al readyAlertedOffset], cl 
CANCELBR [$, 0], c2 
Q «- MD, c3 

[] «■ Q, ZeroBr, cl 
BRANCH [reallyAllocate2, $], c2 
Noop, c3 

MAR «■ [temp2High, temp2Low + signalAlertOffset], cl 
MOR «■ 1. LOOPHOLE [wok], CANCELBR [$, 0], c2 
MesalntRq {run mesa before next bytecode), GOTO [reallyAllocate3], c3 


reallyAl1ocatel: 

CANCELBR [reallyAllocateG, 1], c3 

reallyAl1ocate2: 

Noop, c3 

reallyAllocate3: 

Noop, cl 

templHigh <- uNewObjectHigh , c2 

templLow «- uNewObjectLow , c3 

temp3Low «- uRequestedSize , cl 
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temp3Low «- templLow + temp3Low, {end of the object + L} c2; 
templLow *- templLow + deltaWordOffset, c3; 

{initialize the object header now} 

MAR *- [templHigh, templLow + 0], cl: 
MDR *■ uFieldType, {set delta word} c2; 
templLow *- templLow + offsetFromDel taWordToSizeField , c3: 

MAR *■ [templHigh, templLow +• 0], cl: 
MDR *■ uRequestedSize, c2; 
templLow «* templLow + offsetFromSizeFieldToClassField, c3; 

MAR [templHigh, templLow +■ 0], cl; 
MDR «■ uClassToInstantiate, c2: 
{ok, object header is done, now zap the object body} 

templLow «• templLow + offsetFromClassFieldToFirstField , c3; 

temp2Low *■ uDefault, cl: 
Noop, c2; 
[] *- templLow - temp3Low, ZeroBr, c3: 

initializeObjectBody: 

MAR «- [templHigh, templLow +• 0], BRANCH [$, zapped], cl; 
MDR «• temp2Low, templLow «- templLow 1, c2; 
[] «■ templLow - temp3Low, ZeroBr, GOTO [ ini tial IzeOb jectBody] , c3; 


zapped: {the object header and object body are completely initialized, now fix up the object table entry} 


Noop , 

c2; 



temp3Low *• temp3High {return link}, L2 «- creatingAnlnstance, 

c3; 



temp2High <- newObjectHeader. CALL [getOtFlags], 

cl; 



templLow «- templLow and IF, CALL [putOtFl ags], 

cl, 

at 

[newObjectHeader, 10, getFlagsReturn]; 

temp2Low +■ temp3Low {save return link}, CALL [addToZeroCountTable], 

cl. 

at 

[newObjectHeader. 10, putflagsReturn]; 

Noop , 

cl. 

at 

[creatingAnlnstance, 10. 

addToZeroCountTableReturn]; 




L.1 upClassAtlnstantiation, 

c2; 



otLow *• uClassToInstantiate, XDisp, CALL [refi]. 

c3: 



otLow «- uNewObject, 

cl, 

at 

[upClassAtlnstantiation, 10, refiReturn] 

Xbus <- temp2Low LRotO, XDisp, 

c2: 



RET [createlnstance-return], 

c3; 




{ nextFreeChunk 

Return the next object on a free list. Free objects are linked through their class fields. 

Input: otLow is the current object 

otHigh is the high part of the object table base address 


LI is the return link for otMap2 
L2 is the return link 

output: Q is the next object 

templHIgh/Low is the address of the cur 

smash: } 

nextFreeChunk: 

CALL [otMap2], 

templLow *- templLow + chunkLinkOffset. 

Noop, 

Noop, 

MAR *■ [templHigh, templLow + 0], 

templLow <- templLow - chunkLinkOffset, L2D1sp, 

Q «• MD , RET [nextFreeChunk-return], 


object 


c3: 

cl, at [gettingNextFreeChunk, 10, otMap2-return] 
c2; 
c3: 

cl: 
c2: 
c3; 


{ addToFreeChunkList 

Add an object to the appropriate free list. 

input: otLow is the object 

templHigh/Low is the address of the object 

temp3Low is the index of the list (size of the object for small objects) 
uRumRecordHigh/Low is the Rum communications record base address 
LI is the return link 

output: temp2High/Low is the Rum communications record base address 
smash: Q } 
addToFreeChunkList: 

temp2High «- uRumRecordHigh , cl; 

temp2Low «- uRumRecordLow , c2 ; 
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temp2low <- temp2Low + freeListsOffset, c3; 

MAR *■ [temp2H1gh, temp2Low + temp3Low], cl; 
templlow «- templlow + chunkLinROffset, CANCELBR [$, 0], c2; 
Q <- MD {current free list head}, c3; 

MAR «• [templHigh, templLow + 0], cl; 
MDR «■ Q, {link new object to old list head} c2; 
Noop, c3; 

MAR <- [temp2H1gh, temp2Low + terap3Low] , cl; 
MDR <- otLow {new list head}, LOOPHOLE [wok], LIDisp, CANCEL6R [$, 0], c2; 
templLow <- templLow - chunkLinkOffset, RET [addFreeChunkReturn], c3; 


{ refi 

Increment the reference count of an object. Nil, false, and true have permanently stuck counts, so skip them. Smalllntegers 
don't have reference counts, so skip them too. 

input: otLow is the object 

otHigh is the high part of the object table base address 
LI is the return link 

there is a pending XDisp to test for a smalllnteger 

output: 

smash: templlow, temp2High, Q } 


ref i: 

0ISP4 [refliable, OC], 


cl; 


refiOopOl: 

[] «• falsePointer - otLow, CarryBr, GOTO [doRefi], 


refiOopll: 

[] «- truePointer - otLow, CarryBr, GOTO [doRefi], 


re fiOoplO: 

[] «* i, ZeroBr, GOTO [doRefi], 


c2, at [OD, 10, refiTable]; 


c2, at [OF, 10, refiTable]; 


c2, at [OE, 10, refiTable]; 


refiSmal1IntegerOO: 

LIDisp, GOTO [returnFromRefi], 


c2, at [OC, 10, refiTable]; 


doRefi: 

BRANCH [$, skipRefi], {skip nil, false, true}, 
temp2High <* doingNormalRef i, CALL [getOtFlags], 


Q «- templLow, 

templLow *■ refPlusOneRot8 {for incrementing ref count}, 

[] *■ Q LRotO, XHDisp {first part of test for stuck ref count}, 

templLow *■ templlow LRot8, BRANCH [$, maybeStuckRefi, 2], 

Q *• Q + templlow {up ref count}, {sign is positive, thus not 
stuck and cannot become stuck} 

[] «- 1, ZeroBr, {force next BRANCH} 

updateOtRefi: 

templLow <- Q, BRANCH [{CALL} putOtFlags, justGotStuckRef i] , 


c3; 
cl; 

cl, at [doingNormalRef1, 10, getFlagsReturn]; 
c2; 
c3; 

cl; 

c2; 
c3; 

cl; 


Noop, 

LIDisp, 
returnFromRefi: 

RET [refIReturn], 


cl, at [doingNormalRefi, 10, putFlagsReturn]; 
c2; 

c3; 


maybeStuckRef1: (sign is negative, can get stuck, may already be stuck} 

0 *• Q + templLow {up ref count}, CarryBr {carry implies already stuck}, c2; 
[] *■ Q + tempiLow. CarryBr {carry implies just got stuck}, 

BRANCH [updateOtRef1. $], c3; 

stuckRefi: 

CANCELBR [$, 1], cl; 

stuckRefiReturn: 

LIDisp, GOTO [returnFromRefi], c2; 


justGotStuckRefi; {Loom: need to call Loom here for newly stuck ref count} 


Noop, 

c2 ; 

Noop, 

c3; 

CALL [putOtFlags], 

cl; 


skipRefi: 

GOTO [stuckRefiReturn], 
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{ refd 


Decrement the reference count of an object. Nil, false, and true have permanently stuck counts, so skip them. Small Integers 
don't have reference counts, so skip them too. 

input: otLow is the object 

otHigh is the high part of the object table base address 
LI is the return link 

there is a pending XDisp to test for a small Integer 

output: 

smash: templHigh/Low, temp2High. temp3High/Low, Q, L2 } 


refd: 

temp3Low * refMinusOneRot8, DISP4 [refdTable, OC], 
refdOopOl: 

[] falsePoInter - otLow, CarryBr, GOTO [doRefd], 
refdOopll: 

[] *- truePointer - otLow, CarryBr, GOTO [doRefd], 
refclOoplO: 

[] «• 1, ZeroBr, GOTO [doRefd], 

refdSmal1IntegerOO: 

LIDIsp, GOTO [returnFromRefd], 


cl; 


c2, at [OD, 10, refdTable]; 

c2, at [OF. 10, refdTable]: 


c2, at [OE, 10, refdTable]; 

c2, at [OC, 10, refdTable]: 


doRefd: 

temp3Low *- temp3Low LRot8, 

BRANCH [$, skipRefd], [skip nil, false, true}, c3; 

getRefCount: 

temp2High «- doingNormalRefd , CALL [getOtFl ags] , cl; 

[] <- templLow LRotO, XHDIsp [first part of stuck ref count test}, cl, at [doingNormalRefd, 10, getFlagsReturn]; 

Q <- -tempSLow, BRANCH [$ , negativeRefCount. 2], c2; 

positiveRefCount: [not stuck but could go to zero} 

templLow «• templLow + temp3Low [subtract 1}, CarryBr 

[no carry Implies already zero, an error}, L2 <- doingRefd, c3; 


updateOtRefd: 

BRANCH [triedToRefdZeroCountObject, $], 

Noop, 

Noop, 

CALL [putOtFlags], 

[] *- templLow + temp3Low [subtract again}, CarryBr 
just went to zero}, 

LIDisp, BRANCH [be!ongsInZct, $], 
returnFromRefd: 

RET [refdReturn], 


cl; 
c2; 
c3; 

c 1; 

[no carry implies 

cl, at [doingNormalRefd, 10, putFlagsReturn]; 
c2; 

c3; 


negativeRefCount: [could be stuck but cannot go to zero} 

Q <- Q + 1, [refPlusOneRot8 LRot8} c3; 

[] «- templLow + Q, CarryBr [carry implies stuck ref count}, cl; 

templLow <- templLow + temp3Low [subtract one from ref count}, 

BRANCH [$, stuckRefd], c2; 

[] «• 0. ZeroBr [force BRANCH}, GOTO [updateOtRefd], c3: 


belongsInZct: 

CANCELBR [$, OF], 

CALL [addToZeroCountTable], 

skipRefd: 

GOTO [refdSmal!IntegerOO], 


c3: 
cl; 

cl, at [doingRefd, 10, addToZeroCountTableReturn]; 


stuckRefd: 

GOTO [skipRefd], c3; 


triedToRefdZeroCountObject: 

0 «- refdZero, CANCELBR [bailout3, 1], {error} c2; 


{ refd2 

Identical to refd except for return links. } 
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refd2: 

temp3Low *■ refMinusOneRot8, DISP4 [refd2Tab1e, OC], 
refd20op01: 

[] «- falsePointer - otLow, CarryBr, GOTO [doRefd2], 
refd20opll: 

[] *■ truePointer - otLow, CarryBr, GOTO [doRefd2], 
ref(I20oplO: 

[] <- 1, ZeroBr, GOTO [doRefd2], 

refd2Smal1IntegerOO: 

LlOisp, GOTO [returnFromRefd2], 


cl; 


c2, at [OD, 10, refd2Table]; 

c2, at [OF, 10, refd2Table]; 

c2, at [OE, 10, refd2Table]; 

c2, at [OC, 10 , refd2Table]; 


doRefd2: 

temp3Low *• temp3Low LRot8, 

BRANCH [$, skipRefd2], {skip nil, false, true}, 

getRefCount2: 

temp2High «* doingNormalRefd2, CALL [getOtFlags], 


c3; 

Cl; 


[] ** templLow LRotO, XHDisp {first part of stuck ref count test}, cl, at [doingNormalRefd2, 10, getFl agsReturn]; 

Q <- ~temp3Low, BRANCH [$, negativeRefCount2, 2], c2; 

positiveRefCount2: {not stuck but could go to zero} 

templLow <- templLow + temp3Low {subtract 1}, CarryBr 

{no carry implies already zero, an error}, L2 *■ doingRefd2, c3; 


updateOtRefd2: 

BRANCH [triedToRefd2ZeroCount0bject, $], 

Noop, 

Noop, 

CALL [putOtFlags], 

[] «• templLow + temp3Low {subtract again}, CarryBr 
just went to zero}, 

LIDIsp, BRANCH [belongs!nZct2, $], 
returnFromRefd2; 

RET [refd2Return], 


cl; 
c2; 
c3; 

cl; 

{no carry implies 

cl, at [doingNormalRefdZ, 10, putFlagsReturn]; 
c2; 

c3; 


negativeRefCount2: {could be stuck but cannot go to zero} 

Q <- Q + 1, {refPlus0neRot8 LRot8} c3; 

[] *■ templLow + Q, CarryBr {carry implies stuck ref count}, cl; 

templLow «• templLow + temp3Low {subtract one from ref count}, 

BRANCH [$, stuckRefd2], c2; 

[] «• 0, ZeroBr {force BRANCH}, GOTO [updateOtRefd2], c3; 


belongsInZct2: 

CANCELBR [$, OF], 

CALL [addToZeroCountTable], 

skipRefd2: 

GOTO [refd2SmallIntegerOO], 


c3; 
cl: 

cl, at [doingRefd2, 10, addToZeroCountTableReturn]; 


stuckRefd2: 

GOTO [skipRefd2], 


c3; 


triedToRefd2ZeroCountObject: 

Q *■ refd2Zero, CANCELBR [bailouts, 1], {error} 


{ addToZeroCountTable Loom: Loom may want to get involved here--but I don't think so 

Add an object to the zero count table. Objects get added to the zero count table when their reference counts go to zero. 
Eventually the zero count table fills up and all the objects in it are recursively freed. In the meantime, we turn on the inZct 
bit in the OT and write the new OT entry. Then we look at the object's old inZct bit and add the object to the zct if it's not 
already there. If this object fills the table, we’ll have to stabilize and free soon. There's room for some overflow so we can 
finish this bytecode. 

input: otLow is the object to put into the zct 

otHigh is the high part of the object table base address 
L2 is the return 1 ink 

output: uTimeToStabilize is -1 if the zct is full 

smash: templHigh/Low, temp2High, temp3High/Low, Q } 

addToZeroCountTable: 

temp3Low *• inZctRot8, 
temp3Low «■ temp3Low LRot8 

temp2High «■ addingToZct, CALL [getOtFlags], cl; 


c2: 
c3; 
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[] +■ templLow and temp3Low, ZeroBr, 

templLow *• templLow or temp3Low, L2Disp, BRANCH [al readylnZct, $], 
Q *• uRumRecordHigh, CANCELBR [$, OF] 

templHigh «- Q LRotO, CALL [putOtFIags], 

templLow «- uRumRecordLow, 

Noop, 

Noop, 

MAR «• [templHigh, templLow + zctlndexOffset] , 

CANCELBR [$, 0], 

0 «* MD, (read current index} 

MAR *■ [templHigh, templLow + zctLowOff set], 

CANCELBR [$, 0], 

temp3Low <- MD, [get zct low address} 

MAR «* [templHigh, templLow + zctHighOffset], 
temp3Low «- temp3Low + Q, CANCELBR [$, 0], 
temp3H1gh *■ MD, [get zct high address} 

{ Note: The Molasses zeroCountTable is one-relative, 
something in the zct, we put it in, then bump, } 

MAR *■ [temp3High, temp3Low + 0], 

MDR *- otLow, {add the object} 

Noop, 

MAR *- [templHigh, templLow + zctlndexOff set], 

MDR <- Q «■ Q + 1 {new Index}, LOOPHOLE [wok], CANCELBR [$, 0], 

Noop, 

zctl-ullTest: 

MAR <- [templHigh, templLow + stabil izationLimitOffset], 

CANCELBR [$, 0], 

temp3Low «- MD, [get the zct stabilization limit} 

Noop , 

[] *• temp3Low - Q, NegBr, 

BRANCH [zctlndexOk, $], {need to stabilize if limit exceeded} 

MAR *■ [templHigh, templLow + stabil IzationFlagOffset] , 

MDR «- needToStabil ize, LOOPHOLE [wok], CANCEL8R [$, 0], 
uTimeToStabi 1 ize *• -stackLow xor stackLow {OFFFF}, 

zctlndexOk: 

Noop, 

L2Disp, 
alreadylnZct: 

RET [addToZeroCoun tTableReturn], 


cl, at [addingToZct, 10, getFlagsReturn]; 
c2; 
c3; 

cl; 

cl, at [addingToZct, 10, putFlagsReturn]; 
c2; 
c3; 

cl; 
c2; 
c3: 

cl; 
c2; 
c3; 

cl; 
c2; 
c3; 

not zero-relative. So, while Molasses bumps the index before putting 


cl; 
c2; 
c3; 

cl; 
c2; 
c3; 


cl; 
c2; 
c3; 

cl; 
c2; 
c3; 

cl; 
c2; 
c3; 


cl; 

c2; 

c3; 


{ makeVolatile 


input: 
output: 

smash: temp2H1gh/Low, uZctBaseHigh } 

[upon entry, otLow is the oop to make volatile, uMakeVolatileLinkage is the return linkage register: if it is odd. each object referred 
to by the object will be refd’d; it it is even, the object is marked volatile, but no refding occurs, smashes temp3Low, Q, LI, L2. 
leaves base of object in uMakeVolatileHigh/Low, and in templHigh/Low, leaves uLastPointer set up} 


[see if we're trying to make nil volatile -- this happens when the leaf context oop is nil. 
where volatilization Is done after stabilization.,.} 


check should probably be moved to the place 


makeVolatile: 

[] otLow xor nilPointer, ZeroBr, 

BRANCH [$, nilMakeVolatile], 

uMakeVolatileOop *■ otLow, 

LI *■ makingVolati le , 

CALL [otMap] (get address of base of object}, 

Q * templHigh [save object base} 
uMakeVolatileHigh «- Q, 
uMakeVolatileLow «• templLow, 

{ templLow <- templLow + deltaWordOffset, 

Noop, 

Noop, 

MAR *■ [templHigh, templLow + 0], 

Noop, 

Q «■ MD (delta word}, 

[] *■ Q and volatileBit, ZeroBr {already volatile?}, 
Ybus *■ uMakeVolatileLinkage, XDisp, 

BRANCH [$, doMakeVolatile, OE], 


c2; 
c3; 

cl; 
c2; 
c3; 

cl, 
c2; 
c3; 

cl: 
c2; 
c3: 

cl: 
c2; 
c3: 

c 1; 

c2 ; 


at (makingVolatile, 10, otMap-return]; 
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templLow <- templLow - deltaWordOffset, RET [makeVolatile-return], 


c3; 


doMakoVolatile: 

Q <■ Q or volatlleBIt. CANCELBR [$, Of], 

MAR <- [templHigh, templLow + 0], 

MDR *■ Q {delta word with volatile bit set), 

Ybus «• uMakeVolatileLinkage, XDIsp 

{should we refd the referents or not?}, 

templLow *■ templLow - deltaWordOffset, 

BRANCH [returnFromMakeVolatile, $, OE], 
templLow templLow + sizeFieldOffset, {refd fields) 

Q *■ templHigh, 

MAR *■ [templHigh, templLow + 0], 
templLow «- templLow - sizeFieldOf fset, 

temp3Low +■ MD {size field}, 

temp3Low <- temp3Low + templLow, 

temp3Low e temp3Low - 1 (low 16 bits of last pointer 

of context object}, 
uLastPointer «■ temp3Low, 

{now, sweep the object decrementing reference counts of all pointer 

temp2Low *■ templLow +■ firstPointerFieldOfObject, 
uZctBaseHigh <- Q, 
temp2High *■ Q LRotO, 

makeVolatileLoop: 

MAR *■ [temp2High, temp2Low + 0], LI *■ inMakeVolatile, 
temp2Low «* temp2Low + 1, 

OtLow <- MD, XDisp, CALL [refd], 

temp3Low «- uLastPointer, 

[] <r temp2Low - temp3Low, ZeroBr, 

temp2H1gh *- uZctBaseHigh, BRANCH [makeVolatileLoop, $], 

OtLow *■ uMakeVolatileOop, L2 *■ inMakeVolatile, 

Noop, 

Noop, 

CALL [addToZeroCountTable], 

templHigh *- uMakeVolatileHigh, 
templLow *■ uMakeVolatileLow, 
temp2High *■ uZctBaseHigh, 

Noop, 

returnFromMakeVolatile: 

Ybus <- uMakeVolati leLinkage , XDisp, 
returningFromMakeVolati1e: 

RET [makeVolatile-return], 


nilMakeVolatile: 

GOTO [returnFromMakeVolatile], 


c3; 

cl; 
c2; 

c3; 


cl; 
c2; 
c3; 

cl; 
c2; 
c3; 

cl; 

c2; 
c3; 

f ields} 

cl; 
c2; 
c3; 


cl; 
c2; 
c3; 

cl, at [inMakeVolatile, 10, refdReturn]; 
c2; 
c3; 

c 1; 
c2; 
c3; 

cl; 

cl, at [inMakeVolatile, 10, addToZeroCountTableReturn]; 

c2; 

c3; 

cl; 

c2; 

c3; 


cl; 


{ 1astPo1nterOf 

Return the address of the last pointer field of an object. 

input: templHigh/Low is the address of the object 
Q is the object’s delta word 
L2 is the return link 

output: templHigh/Low is the address of the object 

temp3Low and uLastPointer are the address of the last pointer 

smash: Q } 


lastPointerOf: 

[] <- Q and 1 {pointer bit}, ZeroBr, cl; 

Q «- classCompiledMethodOop, 

BRANCH [doesHavePointers, doesNotHavePointers], c2; 


{is pure pointer object -- last pointer is is at (base + size - 1)} 


doesHavePointers: 

templLow *■ templLow + sizeFieldOffset, c3; 

MAR *■ [templHigh, templLow + 0] {start read of length field}, cl; 

templLow «- templLow - sizeFieldOf fset {again point at base of object}, c2: 
temp3Low *■ MD, GOTO [returnFromLastPointerOf], c3; 


{no pointers, might be compiledMethod -- need to check class} 
doesNotHavePointers: 

templLow *■ templLow + classFieldOffset, c3; 
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MAR «- [teraplHigh, templLow + 0], cl; 
templlow <- templLow - classFieldOffset (again point at base of object}, c2; 
temp3Low «• MD (the class of the object}, c3; 

[] *■ temp3Low xor Q {comp 1ledMethodClass oop}, ZeroBr, cl; 
BRANCH [$, isCompiledMethod], c2: 
temp3Low «- ob jectHeaderS ize, GOTO [returnFromLastPointerOf] , c3; 

(need to get number of literals from the method header} 

IsCompi1edMethod: 

templLow *■ templLow + objectHeaderSize (point at method header}, c3; 

MAR *• [teraplHigh, templLow + 0], cl; 
templLow <■ templLow - objectHeaderSize, (again point at base of object} c2; 
temp3Low *■ MD (the method header}, c3; 

temp3Low *■ {RShiftl temp3Low and OFF) (get literal count 

of compiledMethod}, SE «- 0, cl; 
temp3Low *■ RShiftl temp3Low, SE «- 0, c2; 
Noop, c3; 

Noop, cl; 
temp3Low «- temp3Low + 1 iteralStart, c2; 
temp3Low <- temp3Low + ObjectHeaderSize, c3: 

returnFromLastPointerOf; 

temp3Low «- temp3Low - 1, cl; 
temp3Low <- temp3Low + templLow, L2Disp, c2; 
uLastPointer *• temp3Low, RET [lastPointerOf-return], c3; 


( stabilize 


input: 
output: 
smash: } 

(Test the memory and oop levels and reset alreadyAlerted if both are above their alert levels. 
((wordLevel >= wordAlertlevel) and: [oopLevel >= oopAlertLevel]) ifTrue: [al readyAlerted *■ 0]} 


(linkage register Is LO -- runs only between bytecodes} 
stab 11ize: 

templHigh *• uRumRecordHigh, 
templLow «- uRumRecordLow, 
uTlmeToStabll Ize *■ 0, 

MAR <- [templHigh, templlow + stabil izationFlagOffset], 
CANCELBR [$, 0], 
temp3Low <- MD, XDisp, 

(Molasses clears the stabilization flag on the initial call 
when stabilization is completed. If it is 1 now, we are re 

BRANCH [$, restoreStabi1izeState, 0£]. 

Noop, 

Noop, 

testOopLevel: 

MAR «■ [templHigh, templLow +■ oopLevelLowOffset], 

CANCELBR [$, 0], 
temp3Low *• MD, 

MAR t- [templHigh, templLow + oopAlertLevel LowOffset] , 
CANCELBR [$, 0], 

Q «- MD, 

Q *• temp3Low - Q, CarryBr, 

BRANCH [stabilize2, $], 

Noop, 

testWordLevelHigh : 

MAR *■ [templHigh, templLow wordLevelHighOffset], 

CANCELBR [$, 0], 
temp3Low *■ MD, 

MAR «- [templHigh, templLow + wordAlertLevelHighOffset], 
CANCELBR [$, 0], 

Q «• MD, 

Q *■ temp3Low - Q, CarryBr, 

[] <- Q, ZeroBr, BRANCH [stabilizel, $] , 

BRANCH [resetAlreadyAlerted, $], 

testWordLevelLow; 

MAR *- [templHigh, templLow +■ wo rdLevel LowOf f set] , 

CANCELBR [$, 0], 
temp3Low «■ MD, 


cl; 
c2; 
c3; 

cl; 
c2; 
c3; 

Is set to 1 below while stabilization is occurring and cleared 
ing after a Mesa interrupt.} 

c 1; 
c2; 
c3; 


c 1; 
c2; 
c3; 

cl; 
c2; 
c3; 

cl: 

c2; 

c3; 


cl; 
c2; 
c3; 

cl; 
c2; 
c3; 

cl; 
c2; 
c3; 


cl; 
c2: 
c3; 
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MAR <- [templHigh, templLow + wordAlertLevelLowOffset], cl; 

CANCELBR [$. 0], c2; 

0 «■ MD, c3; 

Q *- temp3Low - Q, CarryBr, cl; 

BRANCH [stabilize3, $], c2; 

Noop, c3; 

resetAlreadyAlerted: 

MAR <- [templHigh, templLow + al readyAl ertedOff set], cl; 

MDR +• 0, LOOPHOLE [wok], CANCELBR [$, 0], c2; 

GOTO [reallyStabilize], c3; 

stabilizel: 

CANCELBR [reallyStabi1ize, 1], c3; 

stabil1ze2: 

GOTO [reallyStabilize], c3: 


stabilize3: 

GOTO [reallyStabi11ze], 


c3; 


reallyStabilize: 

MAR «- [templHigh, templLow + zctLowOffset], cl; 
CANCELBR [$,0], c2; 
temp2Low ♦* MD, [get address of the zct} c3; 

MAR «- [templHigh, templLow + zctHighOffset] , cl; 
uZctBaseLow <- temp2Low, CANCELBR [$, 0], c2; 
Q «• temp2High <- MD, c3; 

uZctBaseHigh *■ Q, cl; 
Noop, c2; 
Noop, c3; 

[get, then smash the zct index from the Rum record) 

MAR <- [templHigh, templLow + zctlndexOffset], cl; 
CANCELBR [$, 0], c2; 
temp3Low *• MD, c3; 

MAR «■ [templHigh. templLow + zctlndexOffset], cl; 
MDR f 0, LOOPHOLE [wok], CANCELBR [$, 0], c2; 
Noop, c3; 

{reset the stabilization flag} 

MAR *■ [templHigh, templLow + stabil izationFlagOf fset], cl; 
MDR «■ 1 [stabilization in progress}, LOOPHOLE [wok], CANCELBR [$, 0], c2; 
temp3Low «- temp3Low + temp2Low [yields low 16 bits of one word past 

the last valid oop in the zct}, c3; 

uZctLimlt *■ temp3Low, cl; 
uQueueHead «- 0, [should be nllPointer} c2; 
uCurrentObject <* 0, [should be nilPointer} c3; 


[sweep the zct. for each oop marked (in its ot entry) as volatile, reset the isVolatlle bit, and increase the reference counts of all of 
its referents, recall that the zct index is one greater than the number of valid entries in the zct} 


stabilizationLoop; 

[] <- temp2Low xor uZctLimlt, ZeroBr [are we there yet?}. cl; 
temp3Low «- OFF, BRANCH [$, countsAreNowCorrect], c2; 
temp3Low *• temp3Low LRot8, c3; 


MAR *■ [temp2High, temp2Low + 0], cl; 
temp2Low *- temp2Low + 1, LI *■ stabilizing, c2; 
otLow «- MD, CALL [otMap2] [so we can get Its delta word}, c3: 


templLow *- templLow + deltaWordOffset, 
temp3Low +■ temp3Low or OFB [yields FFFB, for turning off 
the isVolatile bit}, 

Noop , 


cl, at [stabilizing, 10, otMap2-return 1; 

c2; 
c3; 


MAR «■ [templHigh, templLow + 0] [read delta word} cl; 
Noop, c2; 
Q «- MD, XDisp [to test isVolatile bit}, c3; 


MAR «- [templHigh, templLow + 0], BRANCH [oopIsNotVolati le, $, OB], cl; 

Q MDR *• Q and temp3Low [not volatile anymore!}, 

L2 *■ stabil izingContext, c2: 

templLow <- templLow - deltaWordOffset, CALL [lastPointerOf] , c3; 


[need to move the tempi regs into temp3 to keep refi from smashing them...} 
Q «- templHigh, cl, 
temp3High «• Q LRotO, c2; 
temp3Low <- templLow + classFleldOffset, c3; 


at [stabilizingContext, 10, 1astPointerOf-return]; 


[sweep over the volatile object, upping the reference counts of its referents} 


upReferents: 

MAR «■ [temp3High, temp3Low + 0] , LI correcting, 
Noop, 

otLow *■ MD, XDisp, CALL [refi], 


c 1 
c2 
c3 
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[] temp3Low xor uLastPoInter, ZeroBr, 

temp3Low «■ temp3Low + 1, BRANCH [$, thisOnelsStable], 

GOTO [upReferents], 


cl, at [correcting, 10, refiReturn]; 
c2; 
c3; 


oopIsMotVolatile: 

Noop, c2; 

thi sOrielsStable: 

temp2High «■ uZctBaseHigh , GOTO [stabil izationLoop] , c3; 


[at this point, all contexts have been stabilized, and all reference counts are correct, sweep over the zct again: any object in the zct 
whose reference count is zero is garbage!} 

(temp2H1gh is still valid despite the CALLS, restore temp2Low} 


countsAreNowCorrect: 

temp2Low <* uZctBaseLow, c3; 
sweepAndDeallocateLoop: 

[] «• temp2Low xor uZctLimit, ZeroSr (are we there yet?}, cl; 
temp2High «- uZctBaseHigh, BRANCH [$, returnFromStabl1ize], c2; 
temp3Low «■ inZctRot8, c3; 

MAR <r [temp2H1gh, temp2Low + 0] (get oop from zct} cl; 
temp3Low «• ~temp3Low LRot8, c2; 
otLow *■ MD, c3; 


temp2High «- deallocating, CALL [getOtFlags], cl; 

templLow *• templLow and temp3Low [clear inZct}, CALL [putOtFl ags], cl, at [deallocating, 10, getFlagsReturn]; 


temp3Low * refCountRot8, 
temp3Low +■ temp3Low LRot8, 
Noop, 


cl, at [deallocating, 10, putFlagsReturn]; 
c2; 
c3; 


Noop, cl; 
[] *■ templLow and temp3Low, ZeroBr, c2; 
temp2Low +■ temp2Low + 1, BRANCH [sweepAndDeal locateLoop, $], c3; 

needToDeallocate: 

uZctSweepLow «- temp2Low, cl; 
Noop, c2; 
GOTO [deallocate], c3; 

returnFromDeallocate: 

Noop, cl; 
Noop, c2; 
temp2Low *- uZctSweepLow, GOTO [sweepAndDeal locateLoop], c3; 


returnFromStabi1ize: 

Noop, c 3; 

templHigh <• uRumRecordHigh , cl; 
templLow «■ uRumRecordLow , c2; 
Noop, c3; 

MAR ♦- [templHigh, templLow + stabil IzationFlagOffset] , cl; 
MDR *• 0 (completed), LODisp, LOOPHOLE [wok], CANCELBR [$, 0], c2; 
RET [stabilize-return], c3; 


{ deallocate 

Make an object whose reference count is zero reusable. 

input: otLow is the object to deallocate 

otHigh is the high part of the object table base address 

output: 

smash: Q, uClass, LI, L2 } 


deal locate: 

L2 «- starti ngDeal 1 ocate , 

Noop, 

[] <- otLow LRotO, XDisp, CALL [getClass], 

templLow *■ templLow + deltaWordOffset, 

Q *■ classCompiledMethodOop, 

[] <- temp3Low xor Q, ZeroBr, 

[get delta word to see if object has pointers} 

MAR <- [templHigh, templLow +- 0], 

BRANCH [$, deallocatingACompiledMethod], 

Noop, 

Q *■ MD, XLDisp, 

BRANCH [deallocateWithNoPointers, deallocateWithPointers, 2], 


cl; 
c2; 
c3; 

cl, at [startingDeal1ocate, 10, getClass-return]; 
c2; 
c3; 


cl; 
c2; 
c3; 


deallocateWithNoPointers: 

templLow + templLow - deltaWordOffset, LI <- freeNonPointerObject, 
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uClass <- temp3Low, CALL [adjustLevelsAndReturnToPool ] , 
temp3Low *- uClass, GOTO [nowDoObjectsClass], 


deallocatingACompiledMethod: 

GOTO [deallocateWithPointersA], 


deal locateWithPo inters: 

Noop, 

deallocateWithPointersA: 

templLow «- templLow + offsetFromDeltaWordToClassFleld, 

{enqueue this object for deallocation} 

MAR «- [templHigh, templLow + 0], 

MDR *r uQueueHead, 
uQueueHead «- otLow, 

Noop, 

nowOoObjectsClass: 

Noop, 

otLow <- temp3Low LRotO, XDisp, GOTO [specialRefd], 


c3; 

cl, at [freeNonPointerObject, 10, addFreeChunkReturn]; 

c2; 

c2; 
c3; 

cl; 
c2; 
c3; 

cl; 

c2; 
c3; 


{if there is a current object, continue with it. if not, if there is 
a queued object, start it. otherwise we are done} 

more: 

[] *• rlnterrupt, ZeroBr, L4 <- 2, 

BRANCH [skiplnterrupts, {CALL} servicelnterrupt], 

BRANCH [saveStabi1izeState, $], 
rlnterrupt «■ 20, GOTO [restartMore], 


cl, at [nowDoneWithObject, 10, addFreeChunkReturn]; 
c2; 

c2, at [2, 10, interrupt-return]; 
c3; 


skiplnterrupts: 

Noop, c3; 
restartMore: 

otLow <- uCurrentObject, ZeroBr, cl; 
rlnterrupt «- rlnterrupt - 1, 8RANCH [continueWithCurrentObject, $], c2: 
otLow <- uQueueHead, ZeroBr, c3 ; 

BRANCH [startWithQueueHead, $], cl; 
Noop, c2; 
GOTO [returnFromOeallocate], {all recursive freeing is now complete} c3; 


startWithQueueHead: 

uCurrentObject <- otLow, LI *■ sweepingObject, 
CALL [0tMap2], 

templLow «- templLow + deltaWordOffset, 

Q «- templHigh, 
uSoFarHigh «- Q, 


c2; 
c3; 

cl, at [sweepingObject, 10, otMap2-return]; 
c2; 
c3; 


MAR «• [templHigh, templLow + 0], cl; 
templLow «■ templLow - del taWordOff set, L2 <- getObjectEndForFreeing, c2; 
Q «■ MD, XDisp, [test pointers bit} c3; 

BRANCH [doingACompiledMethod, notDoingACompiledMethod, OE], cl; 


{both isCompiledMethod and doesHavePointers 
doingACompiledMethod: 

CALL [isCompiledMethod], 


live in the 1astPointerOf routine} 
c2; 


notOoingACompiledMethod: 

CALL [doesHavePointers], 


c2; 


uCurrentObjectBaseLow <- templLow, 
lastPointerOf-return]; 
templLow <- templLow + classFieldOffset, 
Noop, 


cl, at [getObjectEndForFreeing, 10, 

c2; 
c3; 


MAR «- [templHigh, templLow + 0], cl; 
Noop, c2; 
temp2Low <- MD [link to next object on queue}, c3; 

uQueueHead <- temp2Low, cl; 
Noop. c2; 
Noop, c3; 


areWeThereYet; 

[] *■ templLow xor temp3Low, ZeroBr, cl; 
templLow «■ templLow + 1, BRANCH [$, doneWithObject], c2 : 
uSoFar *■ templLow, c3; 

MAR «- [templHigh, templLow +■ 0], cl; 
Noop, c2; 
otLow * MD {next field}, XDisp, GOTO [specialRefd], c3; 
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continueWIthCurrentObject: 

templLow *■ uSoFar, c3; 

templHigh «- uSoFarHigh, cl; 

temp3Low «- uLastPointer , c2: 

GOTO [areWeThereYet], c3; 

doneWithObject: 

Noop, c3; 

otLow «■ uCurrentObject, cl; 

templLow «- uCurrentObjectBaseLow, LI *■ nowDoneWithObject, c2; 

uCurrentObject *■ 0 {should be nilPointer}, 

CALL [adjustLevelsAndReturnToPool], c3; 


{ specialRefd 

Decrement the reference count of an object. Nil, false, and true have permanently stuck counts, so skip them. Smal1 Integers 
don't have reference counts, so skip them too. 

input: otLow is the object 

otHIgh is the high part of the object table base address 
temp3Low is a negative one reference count mask 
there is a pending XDisp to test for a smal1 Integer 

output: 

smash: templHIgh/Low, temp2High, temp3High, Q, L2 } 

specialRefd: 

temp3Low «■ refMinusOneRot8, DISP4 [specialRefdTable. OC], cl; 


specialRefdOopOl: 

[] <- falsePointer - otLow, CarryBr, GOTO [specialDoRefd], c2, at [00, 10, specialRefdTable]; 


specialRefdOopll: 

[] <- truePointer - otLow, CarryBr, GOTO [specialDoRefd], c2, at [OF, 10, specialRefdTable]; 


specialRefdOoplO: 

[] «■ 1, ZeroBr, GOTO [specialOoRefd], 


c2, at [OE, 10, specialRefdTable]; 


specialRefdSmalllntegerOO: 

GOTO [speclalStuckRefd], 


c2, at [OC, 10, specialRefdTable]; 


specialDoRefd: 

temp3Low temp3Low LRot8, 

BRANCH [$, skipSpecialRefd], (skip nil, false, true} c3; 


getSpecialRefCount: 

temp2High +■ dolngSpeclalRefd, CALL [getOtFlags], 


cl; 


[] <- templLow LRotO , XHDisp {first part of stuck ref count test}, cl, at [doingSpecialRefd, 10, getFlagsReturn] ; 

Q *■ ~temp3Low, BRANCH [$, negativeSpecialRefCount, 2], c2; 

positiveSpecialRefCount: (not stuck but could go to zero} 

templLow «- templLow + temp3Low (subtract 1}, CarryBr {no carry implies 

already zero, an error}, c3; 

updateOtSpecialRefd: 

BRANCH [triedToSpecialRefdZeroCountObject, $], cl; 

Noop, c2: 

Noop, c3; 


CALL [putOtFlags], 


cl; 


[] «- templLow + temp3Low {subtract again}, CarryBr {no carry Implies 
just went to zero}, 

templLow <- templLow LRot8, BRANCH [specialNeedsDeallocation, $], 

GOTO [more], 


cl, at [doingSpecialRefd, 10, putFlagsReturn]; 
c2; 
c3; 


negativeSpecialRefCount: {could be stuck but cannot go to zero} 

Q *■ Q + 1, (refPIusOneRot8 LRot8} c3; 

[] «* templLow + Q, CarryBr {carry implies stuck ref count}, cl; 

templLow «- templLow temp3Low {subtract one from ref count}, 

BRANCH [$, specialStuckRefd], c2; 

[] *■ 0, ZeroBr {force BRANCH}, GOTO [updateOtSpecialRefd], c3; 

specialNeedsDeallocation: (ref count just went to zero} 

[] <- templLow and inZctRot8, ZeroBr, c3; 

BRANCH [specialAlreadylnZct, $], {deallocate now if not in zct} cl; 

Noop. c2; 

GOTO [deallocate], c3; 
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speclalAIreadylnZct: 

Noop, c2; 

specialStuckRefd: 

GOTO [more], c3; 


skipSpecialRefd: 

GOTO [specialA1readylnZct], cl; 


triedToSpecialRefdZeroCountObject: 

Q «■ specialRefdZero, GOTO [bailouts], 


c2; 


{ adjustLevelsAndReturnToPool 

Put an object on the appropriate free list. Adjust the word count and oop count to include the new free chunk. 

input: otLow is the object 

templHIgh/Low is the object's address 

output: 

smash: temp2High/Low, temp3Low, Q,} 


adjustLevelsAndReturnToPool: 

templLow templLow + sizeFieldOffset, cl: 

temp2H1gh «■ uRumRecordHigh, c2; 

temp2Low «- uRumRecordLow, c3: 

incrementOopLevel: 

MAR *- [temp2High, temp2Low + oopLevelLowOffset |, cl: 

CANCEL8R [$, 0], c2: 

temp3Low *- MD , c3: 

MAR <- [temp2High, temp2Low + oopLevel LowOff set], cl; 

MDR <- temp3Low temp3Low + 1, CarryBr, LOOPHOLE [wok], 

CANCELBR [$, 0], c2; 

8RANCH [increaseWordLevelLow, impossibleOopLevel], c3; 

impossibleOopLevel: 

Q «- tooManyOops , GOTO [bailout2], cl; 


increaseWordLevelLow: 

MAR <- [templHIgh, templLow + 0], cl; 
templLow «- templLow - sizeFieldOffset, c2; 
temp3Low «- MD, c3; 

MAR <- [temp2High, temp2Low +■ wordLevel LowOff set], cl; 
CANCELBR [$, 0], c2; 
Q *■ MD, c3; 

MAR <- [temp2High, temp2Low + wordLevel LowOff set], cl: 
MDR <- Q + temp3Low, CarryBr. LOOPHOLE [wok], CANCELBR [$, 0], c2; 
BRANCH [returnToPool, wordLevelCarry], c3; 


wordLevelCarry: 

MAR <- [temp2High, temp2Low + wordLevelHighOffset], cl; 
CANCELBR [$, 0], c2; 
temp3Low MD, c3; 

MAR *■ [temp2High, temp2Low + wordLevelHighOff set] , cl: 
MDR <- temp3Low temp3Low + 1, LOOPHOLE [wok], CANCELBR [$, 0], c2; 
Noop, c3; 


returnToPool : 

{build a mask to set all ref count bits on and to set purpose bits to free (11)} 


temp3Low «■ refCountRot8, cl; 
temp3Low temp3Low LRot8, c2; 
tempSLow *■ temp3Low or freeOop, c3; 

temp2High «■ return ingToPool , temp2Low *- templLow, CALL [getOtF 1 ags ], cl; 


templLow «- templLow or temp3Low, CALL [putOtFlags], 


cl, at [returningToPool, 10, getFlagsReturn]; 


(upon entry, otLow is the oop of the object to add to the free list, 

templHigh/temp2Low must be that object's base, calls addToFreeChunkList 
thus smashing temp2High/Low and Q. smashes temp3Low} 


addToProperFreeChunkList: 

templLow <- temp2Low + sizeFieldOffset, 
Q «- largestFreeChunkSize, 

Noop, 


cl, at [returningToPool, 10, putFlagsReturn] 

c2: 
c3; 


MAR «- [templHIgh, templLow + 0], cl; 
templLow *• templLow - sizeFieldOffset, c2; 
temp3Low <- MD (object's size}, c3; 

[] *- temp3Low - Q, CarryBr, cl; 
BRANCH [selectRegularList, selectBigFreeList], c2; 
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* 


selectRegularList: 

GOTO [addToFreeChunkList], 


c3; 


selectBigFreeList: 

temp3Low «■ Q, GOTO [addToFreeChunkList], 


c3; 


{ Edit history; 


> 


MemoryManglement.me 


31-Jul-87 15:22:22 PDT 


17 



{ ST80CoreIn1tialVarlableVM.mc 
CorelnltialVariableVM.mc modified for Smalltalk, 
by J Trow 
18-Nov~86 18:16:43 

Copyright 1981, 1982, 1983, 1984, 1985, 1986 by Xerox Corporation. All rights reserved. } 


£ Smalltalk only runs on an 1108 workstation with CPE-FP and MCC-3584 boards. Therefore, all references to Trident and ethernet 
initialization have been removed. } 


Reserve [ProtectStart, ProtectFence], Reserve [OFEO, OFFF]; (save room for boot kernel} 

SetTask [0] 

StartAddress [go]; 

Set [PilotMemoryBanks. 08]; (number of banks of real memory that Pilot knows about} 


go: 


rB 4- 80. CANCELBR [$, OF], 

cl; 


rB <• rB LRot8, 

c2; 

<>♦*} 

MCtl r8, (MCtl «■ 8000} 

c3; 


Bank. *■ 4. {MS[0. . 1] *• 1, Bank <■ 0} 

cl; 

[***} 

IOPCtl «■ 0. 

c2; 


KCtl «■ 0 (SAxOOO}, 

c3; 


DCtl *• 3 (display black, enable task}, 

cl; 


PCtl 0, 

c2; 


ElCtl <- 0, 

c3; 


EOCtl «■ 0, 

cl; 


Noop, 

c2; 


CALL [maplnit], 

c3; 


tialization goes on during this Interval} 




mapRet: 

(clear all but the first two pages of bank 0} 

acR *• 0, c2; 

passTraps *■ acR, c3: 

rO <- 2 , cl; 

rO *■ rO LRot8, c2; 

rDrh <- 0, c3: 

clear: MAR ♦- [rDrh, rO+O], cl; 

MDR <- acR, rO <- rO + 1, ZeroBr, c2; 

BRANCH [clear, $]. c3; 

Noop, cl; 

acR *■ OFF + 1, c2; 

uBootStart «■ acR, GOTO [OnceOnlylni t], c3: 


(OnceOnlylnit transfers control to DoneOnceOnlylnit. DoneOnceOnlyin it lives in the device specific initial microcode. When that 
finishes, control passes to exitToEmulator.} 


exitToEmulator: 

Noop, cl; 

rErh <- IOPageHigh, c2: 

OPYOff: (make sure the display is off when the germ starts} 

acR <- RShiftl 0, SE «■ 1. (acR * 8000} c3; 

rE «- ulOPage, (lOPage real address} cl; 

rB «- uMapPages, c2; 

rBrh *• 0, c3: 

MAR <- [rErh, IOPage.OSCB.syncCmd + 0], cl; 

MDR «- acR, c2; 

rB *■ rB LRot8, c3; 

SetVMMSize: 

MAR «- [rErh, IOPage.VMMSize + 0], cl; 

MOR «- rB, c2: 

enableIOP: 

rQ •- 0, (Set rB to its real value: 0} c3: 

MAR «- [rBrh . 0 +■ 0] , cl: 

MOR *• OFF. -Z : 

Noop. c3- 
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MAR «■ [rBrh. 0 + l] t cl; 
MDR <- uBOOtStart, CANCELBR [$, 0], c2; 
IOPCtl IOPInMode , GOTOABS [IdleLoc], c3; 


{subroutines and end matter} 


{Map initialization -- Sets up map and leaves next available page in topPage. Start looking for pages before 768K, i.e., below bank 0C. 
Does not map any pages in bank 0, 

Bev/are -- clobbers the first word of each page In bank 0 even though you don’t mean it!!!!!!!!!!!!!!!!!!!!!!!! 

Write page number in the first word of each page. Go through memory top down to give lower addresses precedence. 

Register usage 

acR page number 

rB memory address register 

rC temporary 

rD temporary 

rE next available page} 

maplnlt; 

rBrh «■ P 1 1 otMemoryBanks, {start in last bank} cl; {+•++} 

rB «■ 0, (address within bank} c2; 

acR <- rB-1, c3 ; 


passTraps <- acR, (catch faults} 

acR *■ Pi lotMemoryBanks , 

acR «• acR LRot8, (page counter) 


cl; 
c2; 
c3; 


{+++} 


Noop, cl; 

GOTO [markl], c2; 


{mark the first word of each page with its page number} 


markPages: 

MAR <- [rBrh. rB 0], cl; 

MDR *- acR, c2 ; 

markl: 

acR<- acR - 1, NegBr, (written all pages?} c3; 

rC «■ OFF + 1, BRANCH [$, mapBuild], cl; 

rC *■ rB - rC, CarryBr, c2; 

rB *■ rC, BRANCH [$, markPages j, c3 ; 

rB <■ rBrh, cl; 

rB «- rB - 1, c2: 

rBrh «• rB LRotO, c3; 

rB * rC , ci; 

Noop, c2; 

GOTO [markPages]. c3; 


mapBuild; 

Noop, c2; 

Noop, c3; 

rBrh *■ t, cl; 

rC +■ rCrh «- L, c2; 

rB +• 0, c3; 

{make all pages vacant} 

MAR «- [rBrh, rB + 0] . cl; 

MDR «- vacant, c2; 

rErh «■ 0F0 . c3; 


{Do a trial Map operation using a large address. If the Map doesn't trap, our CP board supports large virtual memory, and we set the VM 
size to 23-bit. If the Map traps, we will catch the trap and eventually return to mapOutOfBound, where we set the virtual memory size 
to 22 bits for an older CP board.} 


Map <- [rErh, rE], 

c.l; 

acR <- 80, 

c2: 

GOTO [ 1 argeVMOK], 

c3; 

Bound: (use 22-bit vm} 


acR *• 40, 

iK: 

c3; 

uMapPages «• acR, 

cl; 

rBrh «- 1, 

c2 : 

rC *■ rCrh <- 1, 

c3; 

acR *- acR LRot8, LO «■ OA. 

c 1 ; 

acR *■ acR - 1 , 

c2; 

rB 0 , GOTO [BLT], 

c3; 


(Set up the rE pair with the real address of the virtual memory map 
mapped. acR must contain the page number of the first real page to 

rErh *■ MapRealAddrHIgh , 

rE *■ MapRealAddrLow, 

rBrh <- rB *■ FirstRealPage ToMapHigh, 


and the rB pair with the real address of the first location to be 
be mapped.} 

cl. at[0A, 10. subrRet]; 

c2; 
c3 ; 


l 
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acR «- rB LRot8, (construct page number in acR} cl; 
rC «- FirstRealPageToMap, c2 ; 
rB *■ rC LRot8, c3; 


acR *■ acR or rC, cl; 

Noop, c2; 

(Check if the page has Its own page number in the first location of the page.} 
mapLoop3: 

Noop, c3; 


mapLoopl: 

MAR *■ [ rBrh, rB + 0], 

Noop, 

rC «■ MD, (double bit error possible here} 

[] «- rC xor acR, ZeroBr, 

rC *■ IOPageHIgh, BRANCH [nextReal3, $]. 

(Check if this is the page number of the IOPage. If so, then 


c 1; 
c2; 
c3; 

cl; 
c2; 

do not map this real page yet. Go on to the next real page.} 


rC rC LRo t8, c3; 

rC rC or IOPage . cl; 

[] «■ rC xor acR, ZeroBr. c2; 

rC <• IOPageVi rtual , BRANCH [NotlOPageReal , IsIOPageReal ], c3; 


IsIOPageReal: 

Noop, cl; 

GOTO [nextReal3] , c2; 


(Check if this is the virtual map entry for the IOPage. If so, map the IOPage to this map entry. Do not increment the real page 
number.} 


NotlOPageReal: 

[] +■ rC xor r£, NZeroBr, cl; 

BRANCH [$, NotlOPageVIrt], c2; 

MapIOPage: 

rC *■ IOPage, c3 ; 

rC «■ IOPage, cl; 

rC «• rC LRot8, c2; 

rC *■ rC or IOPageHigh, c3; 

MAR *■ [rErh, r£ + 0] , cl; 

MDR «* rC or present, c2: 

r£ <- rE + 1, GOTO [mapLoopl], c3; 


(Map this page in.} 

NotlOPageVIrt; 

topPage * rB, c3; 

r8<- rB or rBrh, cl; 

rC«- rB, c2; 

r8<- topPage, c3; 

MAR «■ [rErh, rE 0], cl: 

MDR <- rC or present, c2; 

rE «- rE + 1, GOTO [nextReal 1], c3; 


nextReal3: 

Noop, c3; 

nextReal1: 

acR «- acR + 1, GOTO [IncReal], cl; 


nextReal : 

Noop, cl; 

IncReal: 

rC «■ OFF + 1, c2; 

rC rB + rC, CarryBr, c3: 

rB «- rBrh, BRANCH [$, nextBank], cl: 

rB «- rC, GOTO [mapLoop3], c2; 


nextBank; 

rB *■ r8 + 1, c2; 

rO «- Pi lotMemoryBanks , c3; (+++} 

Noop, ci; ( +++ } 

Noop, c2; { +++ } 

[] rB xor rD, ZeroBr, c3; {+++} 

rBrh <- rB LRotO, BRANCH [$, clearMem], ci; 

rB *■ rC, GOTO [mapLoop3], c2 ; 

(clear all mapped pages} 
clearMem: 

topPage *■ rE, (save away} c2: 

rE «■ 0. (word offset} c3; 
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rD «■ 0, {source of zero} 

passTraps «- rD, {die on double bit errors) 

Noop , 

clearLoop: 

MAR «■ [rErh, rE + 0], {read the map} 
rC 4- 0, 
acR <- MD, 

rB *■ acR and OF, 
rBrh *■ rB LRotO, 
rB «■ acR and -OFF, 

{write into every word of the page} 
clearPage: 

MAR +■ [rBrh, rC + 0], 

MDR «■ rD, rC «■ rC + l, PgCarryBr, 
acR * topPage, BRANCH [clearPage, $], 

rE <- rE + 1, 

[] «- rE xor acR, ZeroBr, {compare to topPage} 
BRANCH [clearLoop, $], 

{write 0 to locations 20000 through FFFFF) 
clearExternal: 

rDrh «- 2, {start at end of map (20000)} 
rD M, 

rC *- 0, {source of zero} 

clearl.oopExternal : 

MAR *■ [rDrh, rD + 0], 

MDR <- rC, rD <- rD + 1, CarryBr, 

Q *■ rDrh, BRANCH [clearLoopExternal , $], 

rD «• Q + 1 , 
rDrh *• rD LRotO. 

[] <- rD xor acR, ZeroBr, {last bank?} 

rD <- 0, BRANCH [$, cl earH ighMem], 
acR «■ 10, {end value} 

GOTO [clearLoopExternaI], 

{write 0 to locations 800000 through 8BFFFF} 
clearHIghMem:{+++} 

Noop, 

acR <- 8C,{end value} 

rDrh <- 80, (start at end of gap (800000)} 
rD «- 0, 

rC «- 0, (source of zero} 

clearLoopHlghMem: 

MAR <- [rDrh, rD + 0], 

MDR «- rC, rD «■ rD + 1, CarryBr, 

Q *■ rDrh, BRANCH [cl earLoopHighMem, $], 

rD <- Q + 1, 
rDrh <- rD LRotO, 

[] *■ rD xor acR, ZeroBr, {last bank?} 

rD <- 0, BRANCH [$, mapRet], 

Noop, 

GOTO [clearLoopHighMem], 


cl; 
c2; 
c3; 


cl; 
c2; 
c3 ; 

cl; 
c2; 
c3; 


cl; 
c2; 
c3; 

cl; 
c2; 
c3; 


c 1 : 

{<■ 


c2; 

<:► 


c3; 

{* 


cl; 

0 


c2; 



c3; 

{ + 


cl; 

t* 

++ > 

c2; 

o 


c3; 

c* 


c 1; 

»*»} 

c2; 

[- 


c3; 



c2; {+++} 
c3: {+++} 

cl; {+++} 


cl; {+++} 
c2; (+•++} 
c3; {+++} 

cl; {>++} 
c2; [+++} 
c3; {+++} 

cl; {+++} 

C2; {+++} 

c3; {+~} 


{trap 

catcher, gets here with rC *■ RRotl ErrnIBnStkp} 





error: 







Xbus *■ rC LRotO, XwdDisp, 

c2, 

at 

[ErrorHandlerLoc1 


DISP2 [errorType], 

c3; 





GOTO [death], {control store parity error} 

cl, 

at 

ro. 4 , 

errorfype] 


Xbus «- MStatus, XLDIsp, GOTO [memFaul t]. 

c l, 

at 

[i. 4 , 

errorType] 


GOTO [death], {stack error} 

c 1, 

at 

[2, 4, 

errorType] 


GOTO [death], [instruction buffer empty} 

cl. 

at 

[3, 4, 

errorfype] 

death: 

GOTO [death]. 

c*; 




memFault: 






BRANCH [mapOutOfBound, $, 1], (map out of bound?} 

c2; 





GOTO [nextReal], (no, double bit error} 

c3; 




(b lock 

transfer, takes count in acR, from in rB, and to in rC, 

returns first word past from block in rE} 

BLT2: 

Noop, 

c2; 




BLT3 : 

Noop . 

c3 : 




BLT: 

MAR <- [rBrh, rB + 0], 

cl; 





[] *■ acR, ZeroBr, 

c2 : 
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rE <- MD, BRANCH [$, endBLT], c3; 

MAR *■ [rCrh, rC + 0], cl; 

MDR *■ rE, c2; 

acR «- acR - 1, c3; 

rB <- rB +• t, cl; 

rC *• rC *■ 1. c2; 

GOTO [BLTJ, c3; 


endBLT: 

Noop, cl; 

endBLTl: 

pRetO, c2; 

endBLT2; 

RET [sufarRet], c3: 
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--- Package: Smalltalk80 Object Memory Implementation. 

Part A: Procedures for initialization, reference counting, 
garbage collection, and allocating and deallocating objects. 


-- last edited by Malcolm 

19-Jun-87 11:18:02 cosmetic 

18-Jun-87 18:33:54 root test 

-- 18-Jun-87 18:05:59 LastOffsetOf [LastPointerOf - 1] 

-- 18-Jun-87 16:54:12 debugging 

-- 18-Jun-87 15:05:10 iterative Deallocate 

-- 29-Api—86 14:48:58 use memoryHoleRealStart ' 

-- 26-Mar-86 14:26:12 simplify AddToZeroCountTable; countDowns statistics 

-- 10-Jan-86 14:40:58 check class in Deallocate 

--- 15-Oct-85 19:09:19 oop-Level ptr to CARD [not long] 

-- 7-Oct-85 17:10:26 use RefI, RefD 

7- Oct-85 11:55:51 speed AddToZeroCountTable 

-- 17-Sep-85 14:47:56 cleanup/speed CountDown, Deallocate, ... 

9-Sep-85 18:10:55 refl, refD speed 
-- 6-Sep-86 19:16:05 "G 

-- 30-Aug-85 11:48:29 startlnit in Createlnstance, Allocate 
-- 15-Aug-85 18:13:53 use OtlndexOf[oop] > 3 in refl refD 
-- 26-Jul-85 16:53:12 minor speed ups - refl, refD 
-- 8-Jul-85 17:16:28 USING for all 

2- Jul-85 19:00:14 move memoryAlertSemaphore to D 

6- Jun-85 14:03:38 oop > truePointer [Instead of 6] 

3- Apr-85 19:32:40 begin Stretch [use OopFromOtlndex] 

-- 13-Feb-85 13:47:23 debug figs in ST80DebugFlags 

8- Feb-85 18:42:35 explicit init of internal ptrs 

8-Feb~85 14:51:25 use TRUE instead of debugRefCountFlg 

-- 8-Feb-85 12:30:53 SetRefCountOf 

4- Feb-85 17:25:18 Fetch, Smash 

2-Feb-85 16:44:16 check CountDown past 0 

-- 30-Jan-85 17:15:44 move allocation and lists to ST80MemImplD 

— 29-Jan-85 19:52:29 adjust for memory hole 

-- 28-Jan-85 14:02:20 removed some old code in comments 

-- 18-Jan-85 11:33:35 check < minSize before try to AddToFreeChunkList 

-- 16-Jan-85 18:50:33 size checks for lists: link using Copy*to* 

-- 15-Jan-85 16:53:42 currentChunkAddress calculated only when valid 

-- 15-Jan-85 16:47:53 tests for Smalllnteger oop in AddToFreeChunkList 

-- 12-Jan-85 18:01:48 removed use of SmashLONG 

-- 17-Dec-84 15:41:51 move Stabilize, Volatilize, MakeVolatile to st80MerrImplD 

-- 17-Dec-84 11:12:59 BITAND, BITOR removed 

-- 15-Dec-84 13:14:51 SmashOTEntry 

-- 15-Dec-84 13:00:49 fix OTEntry refs 

-- ll-Dec-84 19:01:13 ptr shufflihg using PMem* 

-- ll-Dec-84 17:56:10 lastOop -> lastOopIndex 

-- ll-Dec-84 13:26:21 [l..lastOop] 

7- Dec-84 13:46:58 memory accesses in 

AddToTemporaryFreeList RemoveFromTemporaryFreeList 
-- 6-Nov-84 14:30:23 

DIRECTORY 

Runtime USING [CallDebugger], 

Inline USING [LowHalf], 

ST80Send USING [1iteralStart], 

ST80Defs USING [Address, AddressOf, At, classCompi1edMethodPointer, DeltaWord, falsePointer, 
lastOopIndex, Loc, maxCount, nilPointer, objectFieldBase, objectMemory, objectMemoryPages, Of, Oop, 
OopFromOtlndex, OopIsSmallInteger, OTEntry, OtEntry, OtlndexOf, Physical, PhysicalAddress, PMemFetch, 
PMemSmash, PMemSmashlnvisibly, RealFetch, RealSmash, SetOTAddressOf, Smalllnteger, SmashOTEntry, 
truePointer, Virtual, VirtualAddress, Word], 

ST80Debug USING [LogRefCountDown, LogAdditionToZCT, watchOopFlg, watchedOopl, 

STSODebugFlags, 

ST80Mem USING [AddToFreePointerList, AddToProperFreeChunkList, Allocate, bigSize, chunkLinkOffset, 
FetchClass, IntegerObjectOf, IsClass, IsIntegerObject, minSize, nonAddress, nonPointer, 
objectClassOffset, ObjectFieldType, objectSizeOffset, RefD, Refl, RemoveFromFreePointerList, 
RemoveFromTemporaryFreeList, StackTop, tempSizeOffset, UnaryPrimReturn, Volatilize, zctlndexLimit, 
zctSize], 

ST80Pilot USING[imageSize, memoryHoleSize, memoryHoleRealStart], 

Sl'80Rum USING [common. Stabilize], 

ST80Stretch USING [StretchHeader]; 

ST80MemImplA: PROGRAM 

IMPORTS Runtime, Inline, ST80Pilot, 
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ST80Debug, ST80Rum, ST80Mem, ST80Defs 
EXPORTS ST80Mem = BEGIN 
OPEN ST80Defs, ST80DebugFlags, ST80Mem, 

DBug: STSODebug, Pilot: ST80Pilot, Rum: ST80Rum, Send: ST80Send; 


Important constants 


Controls conditional compilation to preclude actual deallocation 
--- of objects 

rioDeallocateFlg: BOOLEAN = FALSE; 


-- Internal state of the Object Memory 


-- Initialize them explicitly in StartMemModule 
-- to insure that @Rum.common is correct 

-- Note that our implementation departs from the book in that there 
-- is no segmentation of real memory. The standard free lists are 
-- indirect in order to make them efficiently accessible from Rum 
-- (they are part of the Rum/Molasses common area.) 

freePointerListHead: PUBLIC LONG POINTER TO Oop; 

freeChunkListHeads: PUBLIC LONG POINTER TO ARRAY [0..bigSize] OF Oop; 
tempFreeChunkListHead: PUBLIC VirtualAddress <- nonAddress; 

— Zero count table and associated apparatus 
zctlndex: PUBLIC LONG POINTER TO CARDINAL; 

zeroCountTable: PUBLIC LONG POINTER TO ARRAY (0..zctSize] OF Oop; 
stabilizeFlg: PUBLIC LONG POINTER TO BOOLEAN; 

-- Word and Oop lower limits which, when reached, should cause a 

— signal to the designated semaphore. The alert levels are 

-- indirect in order to make them efficiently accessible from Rum 

— (they are part of the Rum/Molasses common area.) 

wordAlertLevel; PUBLIC LONG POINTER TO LONG CARDINAL; 
oopAlertLevel: PUBLIC LONG POINTER TO CARDINAL; 
alreadyAlerted: PUBLIC LONG POINTER TO Word; 

-- Registers containing the number of Oops and words remaining 
-- in the object memory. Thdse are indirect in order to make them 
-- efficiently accessible from Rum (they are part of the Rum/Molasses 
-- common area.) 

wordLevel; PUBLIC LONG POINTER TO LONG CARDINAL <- @Rum.common.wordLevel; 
oopLevel : PUBLIC LONG POINTER TO CARDINAL; -- «- 0Rum. common . oopLevel; 


-- Initialization: 


StartMemModule: PUBLIC PROCEDURE = 

BEGIN 

-- Believe it or leave it, this is the best way of getting this 
-- module STARTed. The "right" way involves importing this PROGRAM 
-- into some other PROGRAM, which causes unwanted binding/compilation 
-- dependencies. 

-- initialize lists, etc., explicitly 
— since timing of init @Rum.common is uncertain 

freePointerListHead «- SRum.common.freePointers; 
freeChunkListHeads «- 0Rum. common .freeLists; 
zctlndex «- 0Rum.common .zctlndex: 
stabilizeFlg <- @Rum.common.stabilizationNeeded; 
wordAlertLevel «- @Rum. common .wordAl ertLevel; 
oopAl ertLevel «- LOOPHOLE[@Rum. common . oopAl ertLevel ] ; 
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alreadyAlerted «- @Rutn.common.alreadyAlerted; 
wordLevel «- @Rum.common.wordLevel; 
oopLevel «- LOOPHOLE[0Rum.common.oopLevel]; 


END; 


InitializeObjectMemory: PUBLIC PROCEDURE = 

BEGIN 

-- This procedure sets up the free pointer list and free chunk 
-- lists. ' 

newChunkOop: Oop «- NULL; 
chunkSIze: CARDINAL <- NULL; 
longChunkSize; LONG CARDINAL <- NULL; 
otEntry: OTEntry; 

virtualHoleStart: VirtualAddress = Virtual[Pilot.memoryHoleRealStart]; 

-- The largest possible chunk must leave room in its segment for 
-- at least one other object (otherwise, we would leave holes 
-- between the segments - not nice.) 

maxInitialBigChunkSize: LONG CARDINAL = 

LONG[LAST[CARDINAL]] + 1 - minSize; 

-- Determine the size and location of the primordial free chunk, 

remainderSize: LONG CARDINAL «- 

(LONG[objectMemoryPages] * LONG[256]) - Pilot.imageSize; 
remalnderAddress; Vi rtualAddress <- objectMemory + 

Pilot.imageSize; 

— adjust for extended memory high bit 
IF remainderAddress > virtualHoleStart THEN 

remainderAddress *- remainderAddress + Pilot.memoryHoleSize; 

-- Initialize the volatile context stabilization apparatus: 

zctlndext <- 0; 
stabil izeFlgt *- FALSE; 

-- Initialize the memory counters and alert levels 

wordLevelT «- LONG[0]; 
wordAlertLevelt <- L0NG[0]; 

Rum. common. oopLevel <- LONG[0]; -- in case Rum looks at high bits 
Rum.common.oopAlertLev'el «- LONG[0]; -- ditto 

-- Initialize the free pointer list. 

freePointerListHeadt «- nonPointer; 

-- Find the free entries in the OT and add them to the free 
-- pointer list. LOOM Sensitive. 

FOR otlndex: CARDINAL DECREASING IN [1..1astOopIndex] DO 

-- Checking whether the reference count is zero is 
— superfluous since there should be no free objects 
-- at this point. 

IF OtEntry[At[otIndex]].purpose = free 

THEN AddToFreePointerList[OopFromOtIndex[otIndex]]; 

ENDLOOP; 

-- Initialize the free chunk lists to be empty. 

FOR size: CARDINAL IN [0..bigSize] DO 
freeChunkListHeads[size] <- nonPointer; 

ENDLOOP; 

-- There will have been some segment breakage placed on a 
-- temporary free list during the loading process. Shuffle 
-- this onto the appropriate free lists. Me are guaranteed 
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-- that none of these remainders is of segment size, therefor 
-- no need to futz with LONG quantities. 


WHILE tempFreeChunkListHead # nonAddress 00 

start: Vi rtualAddress +■ RemoveFromTemporaryFreeList[] ; 

oop: Oop «- RemoveFromFreePointerList[]; 

size: CARDINAL <- PMemFetch[start + tempSizeOffset]; 

IF size < mlnSize THEN Runtime.Cal 1Debugger[ 

"Attempt to link too small a chunk into freeChunkList."G]; 

-- Make the Oop point at the chunk. Give the Oop an artificial 
-- reference count to distinguish it from a free Oop. 

SetOTAddressOf[oop, start]; 
otEntry «- 0tEntry[0f [oop]] ; 
otEntry.referenceCount.count *- maxCount; 

SmashOTEntry[Of[oop], otEntry]; 

— Mark the chunk properly with its size. 

PMemSmash[start + objectSizeOffset, size]; 

-- Distribute the chunk onto the proper free list. 

AddToProperFreeChunkList[oop: oop, address: start, size: size]; 
ENDLOOP; 

-- Use the primordial free chunk to finish initializing the 
-- free chunk lists. We want to guarantee that no chunk will 

— cross a segment boundary. On the other hand, no chunk can 

— be of segment size. Therefore, in each segment, carve out 

— a very large chunk, followed by a minimum size chunk. 

WHILE remalnderSize > 0 
DO 

-- Determine the size of the next initial chunk and 
-- mark the chunk with its size before cutting it out. 

longChunkSize «- MIN[ 

LONG[SegmentRemainder[remainderAddress]] + 1, 
remainderSize, 
maxlnitialBigChunkSize]; 
chunkSize <- Iniine.LowHalf[1ongChunkSize]; 
PMemSmashInvisibly[remainderAddress + objectSizeOffset, 
chunkSize]; 

-- Acquire an Oop for the new initial chunk, mark the Oop 
-- not free and set it to point at the chunk. 

newChunkOop *- RemoveFromFreePointerList[]; 

SetOTAddressOf[newChunkOop, remainderAddress]; 

-- Give the Oop to the free chunk an artificial reference 
-- count so it won't be confused with a free Oop. LOOM 
-- Sensitive. 

otEntry «- 0tEntry[0f [newChunkOop]] ; 
otEntry.referenceCount.count «- maxCount; 

SmashOTEntry[Of[newChunkOop], otEntry]; 

-- Add the new chunk to the appropriate free chunk list, and 
-- debit the remainder of the primordial chunk. 

AddToProperFreeChunkList[oop: newChunkOop, .address: 

remalnderAddress, size: chunkSize]; 
remai nderAddress <- remalnderAddress + longChunkSize; 

-- adjust for real memory address hole 
IF remainderAddress = virtualHoleStart THEN 

remalnderAddress «- remainderAddress + Pilot.memoryHoleSize; 
remainderSize <- remainderSize - LONG[chunkSize]; 

ENDLOOP; 

-- Determine the number of Oops and words available in the 
-- newly initialized memory. 
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[oopLevelT, wordLevelt] «- StorageRemaining[]; 
END; 


-- Initialization support: 


StorageRemaining; PROCEDURE RETURNS 

[totalOops: CARDINAL, totaiWords: LONG CARDINAL] = 

BEGIN 

/ 

-- Determine how many unallocated Oops words remain in the object 
-- memory, 

smallChunk: Oop <- NULL; 

smal IChunkCount: CARDINAL «- NULL; 

bigChunk; Oop <- NULL; 

bigChunkAddress; VirtualAddress <- NULL; 

freeOop: Oop «- freePointerListHead*; 

totalOops *- 0; 

totaiWords «- 0; 

-- Add up the Oops on the free Oop list. 

WHILE freeOop # nonPointer DO 
totalOops *- totalOops + 1; 

freeOop <- LOOPHOLE[OtEntry[Of[freeOop]].offsetLow, Oop]; 
ENDLOOP; 

— Add up the words and Oops entailed in uniform-size small 

— chunks. 

FOR smallChunkSize; CARDINAL IN [minSize..bigSize) DO 
smallChunk <- f reeChunkListHeads[smal IChunkSize]; 
smal IChunkCount «- 0; 

WHILE smallChunk # nonPointer DO 

smallChunkCount <- smallChunkCount + 1 ; 
smallChunk «- LOOPHOLE[PMemFetch[ 

AddressOf[smallChunk] + chunkLinkOffset], 

Oop]; 

ENDLOOP; 

totalOops <- totalOops + smallChunkCount; 
totaiWords <- totaiWords + LONG[smallChunkSize] * 

LONG[smallChunkCount]; 

ENDLOOP; 

-- Add up the words entailed in non-uniform big chunks. 

bigChunk <- f reeChunkListHeads[bigSize] ; 

WHILE bigChunk # nonPointer DO 

bigChunkAddress *■ AddressOf [bigChunk]; 
totalOops *■ totalOops + 1; 
totaiWords *• totaiWords + 

LONG[PMemFetch[bigChunkAddress + objectSizeOffset]]; 
bigChunk «- LOOPHOLE[PMemFetch[ 

bigChunkAddress + chunkLinkOffset], Oop]; 

ENDLOOP; 

RETURN[totalOops, totaiWords]; 

END; 


Public because it is needed for segment boundary alignment while 
-- loading 

SegmentRemainder: PUBLIC PROCEDURE [virtual: VirtualAddress] RETURNS 
[CARDINAL] = 

BEGIN 

— Say how many words remain in virtual's segment, counting from, 
-- but not including, virtual. 

real: PhysicalAddress «- Physical [vi rtual ] ; 

RETURN[177777B - Iniine.LowHalf[real]]; 
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END; 


-- Reference counting 


IncreaseReferences: PUBLIC PROCEDURE [oop; Oop] = {RefI[oop]}; 


DecreaseReferences: PUBLIC PROCEDURE [oop: Oop] = {RefD[oop]}; 


AddToZeroCountTable: PUBLIC PROCEDURE [new: Oop] = 

BEGIN 

-- Add the Oop to the ZCT for later possible deallocation or 
-- processing as a volatile context, but only do this if it 
— is not already there. 

otPtr: LONG POINTER TO OTEntry = Of[new]; 

IF -otPtr.inZeroCountTable 
THEN BEGIN 

index; CARDINAL = zctlndext + l; 

-- Inserted for debugging purposes 
IF debugFIg 

AND new = DBug.watchedOop 

AND DBug.watchOopFlg 

THEN DBug.LogAdd1tionToZCT[]; 

IF debugFIg 

AND index > zctSize 

THEN Runtime.Cal lDebugger["Zero count table overflow"G]; 

otPtr. inZeroCountTable <- TRUE; 
zctlndext «- index; 
zeroCountTable[index] «- new; 

IF index > zctlndexLimit 
THEN stabi 1 izeFlgt <- TRUE; 

END; 

END; 


-- Deallocation: 


-- for debug access 
interruptPending: BOOLEAN «- FALSE; 

Deallocate: PUBLIC PROCEDURE [freeing: Oop] 

= BEGIN 

-- free this oop and Deallocate any of its fields that refD to 0, 

-- essentially recursive, freeing a tree based at oop. 

-- this is an 'iterative' version; recursion state is hidden in the tree. 

-- last is offset of next field to deal with; held in delta word. 

-- last is descending, so don't have to remember stop index. 

-- when going another level, link back is put in this last field. 

(which formerly held reference to the oop for the new level) 

ENABLE ANY => Runtime.CallDebugger["Deal 1ocate problem"L]; 

LastOffsetOf: PROC [o: Oop] RETURNS [1: CARDINAL] 

= INLINE {1 «- LastPoi nterOf[o] - l}; 

RefDCount: PROC [o: Oop] RETURNS [c: CARDINAL] 

= INLINE {RefD[o] ; c *- oep . ref erenceCount. count); 

next: Oop «- nilPointer; — parent object of freeing tree 
oep: LONG POINTER TO OTEntry <- Of[freeing]; — for freeing or ref 
loc: PhysicalAddress «- Loc[oep]; -- start of object header 
last: CARDINAL; -- offset of last reference field; decremented 
ref: Oop; -- object referenced in last' field 
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IF OopIsSmallInteger[freeing] 

OR oep.purpose # inUse 

OR oep. referenceCount, count tt 0 

THEN RETURN; 

last <- LastOffsetOf[freeing]; 

WHILE TRUE -- RETURN in nested loop 
00 

-- at this point freeing is ready to peel off another reference 
-- or suspend for interrupt, with state minimized to freeing and next 

IF interruptPending 
THEN BEGIN 

RealSmashfloc, last]; -- remember where to pick up 
— SaveFreeingAndNext; 

-- OeferToMesa; 

-- RestoreFreeingAndNext; 
loc *■ Loc[Of[freeing]]; 
last <- Real Fetch[loc] ; 

END; 

ref <- RealFetch[loc + last]; 
oep «- Of [ref ]; 

IF OopIsSmallInteger[ref] 

OR oep.referenceCount.count = maxCount 
OR RefDCount[ref] > 0 
THEN last <- last - 1 
ELSE BEGIN 

— this ref must be (recursively) deallocated, ie become freeing 
RealSmash[loc, last]; -- remember field to resume in freeing 
RealSmash[1oc + last, next]; -- and how to go back up tree 

— change levels & regenerate locals 
next «- freeing; 

freeing *■ ref; 

loc <- Loc[0f[freeing]]; 

last *• LastOffsetOf[freeing]; 

END; 

-- only loops in case class gets deallocated 

-- multiple loop probably impossible or at least astronomically rare 
WHILE last < objectClassOffset 
DO 

oep +- 0f[freeing]; -- oep no longer needed for ref 

— Adjust OTEntry for free object 

oep.purpose <- free; 

oep. referenceCount.count <- maxCount; 

— and link its chunk into free list (and update words, oops left) 
AddToProperF reeChunkList[ 

oop: freeing, 
address: Address[oep], 

size; RealFetch[loc + objectSizeOffset]]; 

— go back up the tree 
freeing <- next; 

IF freeing = nilPointer THEN RETURN; — finished traversing tree 

loc *■ Loc[0f[freeing]]; 
last <- Real Fetch[loc]; 
next <- Real Fetch[loc + last]; 
last *- last - 1; 

ENDL00P; 

ENDLOOP; 

END; 

« 

Deallocate: PUBLIC PROCEDURE [freeing: Oop] = 

BEGIN 

-- Free an object, and as well all other objects to which it 
-- refers (concatenatively) uniquely. This is the recursive 
-- version. 
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otPtr: LONG POINTER TO OTEntry = Of[freeing]; 
loc: PhysicalAddress <- Loc[otPtr]; 

-- Inserted for debugging purposes 
IF debugFlg 

AND freeing = DBug.watchedOop 
AND DBug.watchOopFlg 

THEN Runtime.CallDebugger["Watched Oop is being deallocated"G]; 

IF debugFlg 

AND NOT IsClass[FetchClass[freeing]] 

THEN Runtime.CallDebugger["Bad / class field"G]; 

IF noDeallocateFlg 
THEN BEGIN 

ChasePointersAdjustingReferences[from: freeing]; 

RETURN[]; 

END; 

-- Chase all the references from the object being freed. 

FOR offset: CARDINAL 

IN [objectClassOffset..LastPointerOf[object: freeing]) 

DO CountDown[RealFetch[loc + offset]] ENDLOOP; 

-- Mark the chunk as free by setting its purpose code and giving 

-- it an artificial reference count (to distinguish it from a free Oop.) 

otPtr.purpose «- free; 

otPtr. referenceCount.count «- maxCount; 

--SmashOTEntry[Of[freeing], freeingOTEntry]; 

-- Put the current free chunk where it belongs. 

AddToProperFreeChunkL1st[oop: freeing, address: Address[otPtr], 
size: RealFetch[loc + objectSizeOffset]]; 

END; 


LastPointerOf: PUBLIC PROCEDURE [object: Oop] RETURNS [CARDINAL] = 

BEGIN 

-- Note that this returns the number of pointer fields counting 

— from the very start of the object (including the delta word) 

— 'rather than the offset of the last pointer field. The first 

— edition of the book contains a bug: it asserts that compiled 

— methods have the pointer bit set. 

loc: PhysicalAddress «- LOOPHOLE[OtEntry[Of[object]]]; 
delta: DeltaWord «- Real Fetch[loc] ; 

IF delta.hasPointers 

THEN RETURN[Real Fetch[1oc + objectSizeOffset]] 

ELSE BEGIN 

class; Oop = RealFetch[loc + objectClassOffset]; 

IF class = classCompiledMethodPointer 
THEN BEGIN 

header: STSOStretch. StretchHeader <- Real Fetch[loc + objectFi el dBase]; 

RETURN[header.1 its + Send.1iteralStart + objectFieldBase]; 

END 

ELSE RETURN[objectFieldBase]; 

END; 

END; 


for gathering statistics 
countDowns: BOOLEAN *■ FALSE; 
ints: LONG CARDINAL <- 0; 
nils: LONG CARDINAL *- 0; 
falses: LONG CARDINAL <- 0; 
trues: LONG CARDINAL - 0; 
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oops: LONG CARDINAL «- 0; 


CountDown: PROCEDURE [oop: Oop] = 

BEGIN 

— Same as DecreaseReferences, 

— except actually Deallocate rather than add to zct 
index: CARDINAL <- NULL; 

— Inserted for debugging purposes 
IF debugFlg 

AND oop = DBug.watchedOop 

AND DBug.watchOopFlg 

THEN DBug.LogRefCountDown[]; 

IF countDowns 
THEN BEGIN 

IF OopIsSmallInteger[oop] 

THEN ints «- ints + 1 

ELSE oops *■ oops + 1; -- includes nil, false, true 

IF oop = nilPointer THEN nils *■ nils + 1; 

IF oop = falsePointer THEN falses <- falses + 1; 

IF oop = truePointer THEN trues «- trues + 1; 

END; 

IF ~OopIsSmallInteger[oop] 

AND (index «- OtlndexOf[oop]) > 3 
THEN BEGIN 

otLocl: PhysicalAddress = Physical[At[index]] + 1; 
hiOtWord: CARDINAL «- Real Fetch[otLocl] ; 

IF hiOtWord < 176000B -- not stuck 

THEN IF hiOtWord < 2000B 

THEN Runtime,CallDebugger[’'Decrement of zero reference count"G] 
ELSE BEGIN 

RealSmash[otLocl, hiOtWord - 2000B]; -- deer by 1 

IF hiOtWord < 400QB -- ref ent was 1 

AND hiOtWord < 3000B -- not in zct already 
THEN Deallocate[oop]; 

END; 

END; 

END; 


--'Reference counting debug assists: 


ChasePointersAdjustingReferences: PROCEDURE [from: Oop] = 

BEGIN 

-- This is a stand-in for Deallocate, so that when debugging 
-- reference counting problems we can go into a mode in which 
-- nobody is actually deallocated. 

objectAddress: VirtualAddress = AddressOf[from]; 

FOR offset: CARDINAL IN 

[objectClassOffset.,LastPointerOf[object: from]) DO 
CountDown[LOOPHOLE[PMemFetch[objectAddress + offset], Oop]]; 
ENDLOOP; 

END; 

-- In order to allow inspection of reference counts from Smalltalk, 
-- the following primitive is.provided. 

PrimitiveRefCount: PUBLIC PROCEDURE = 

BEGIN 

-- Return the reference count of the receiver, subtracting 
— one to account for the reference from the active context. 

receiver: Oop = StackTop[]; 
refCount: Smal 1 Integer «- NULL; 

IF IsIntegerObject[receiver] THEN refCount «- 0 
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ELSE 

BEGIN 

Rum.Stabilize[]; 

refCount *■ OtEntry[Of[receiver]].referenceCount.count; 
IF refCount ff maxCount THEN refCount <- refCount - 1; 
Volati1ize[]; 

END; 

UnaryPrimReturn[IntegerObjectOf[refCount]]; 

END; 


-- Object creation; 


Createlnstance: PUBLIC PROCEDURE [classOop: Oop, fieldType: 

ObjectFieldType, fields: CARDINAL, startlnit: CARDINAL *- 0] RETURNS [Oop] = 
BEGIN 

size: CARDINAL «- NULL; 
new: Oop «- NULL; 

SELECT fieldType FROM 
pointer => 

BEGIN 

-- Note there is no need to insert an extra word at the 
— end of very large pointer objects, because the microcode 
-- will use Glenn's tail recursive algorithm (which chains 
-- via the class field) and Molasses uses full recursion. 

size *■ fields + objectFieldBase; 
new «- Allocate[size: size, odd: 0, pointers: TRUE, 
class: classOop, startlnit: startlnit]; 

END; 
word => 

BEGIN 

size *■ fields + objectFieldBase; 

new <- Allocate[size: size, odd: 0, pointers: FALSE, 
class: classOop, startlnit: startlnit]; 

END; 
byte => 

BEGIN 

Size «- IF fields = LAST[CARDINAL] THEN 

(fields / 2) + 1 + objectFieldBase 
ELSE (fields + l)/2 + objectFieldBase; 
new <- A11ocate[size: size, odd: fields MOD 2, pointers: FALSE, 
class: classOop, startlnit: startlnit]; 

END; 

ENDCASE; 

RETURN[new]; 

END; 


-- For debugging 

Fetch: PROC [loc: LONG UNSPECIFIED] RETURNS [UNSPECIFIED] = BEGIN 
RETURN [RealFetch[loc]]; END; 

Smash: PROC [loc: LONG UNSPECIFIED, value: UNSPECIFIED] = BEGIN 
RealSmash[loc, value]; END; 


SetRefCountOf: PROC [oop: Oop, count: UNSPECIFIED] = BEGIN 
otEntry: OTEntry *■ OtEntry[Of [oop]] ; 
otEntry. referenceCount *■ LOOPHOLE[count] ; 
SmashOTEntry[Of[oop], otEntry]; 

END; 


END. 
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"" t)of i ni t ions : Tim procedures implementing Smalltalk80 multi-processing 
-*■ 'primitives. 


a - J li 1 - 8 l:i 1 !5: a 7 :3 0 Malcolm: USING, semaphorelndex 
-- last edited by Zdybel , l-Aug-84 13:20:154 

DIRECTORY 

Sl'SODefs USING [Oop]; 

STOOProc: DEFINITIONS = 

BEGIN OPEN SiaODefs; 


Fields of Process-related classes made public here for the 
-- sake of Initializelnterpreter 


activeProcossIndex: CARDINAL = 1; 
suspendedCon toxtlndex : CARDINAL = 1 ; 


-- Public for the sake of space layout 


semaphoroTableSize: CARDINAL = 256; 

sernaphorelablo : LONG POINTER TO ARRAY [0 . . semaphoreTabl eS ize) Of Oop; 
semaphorelndex: READONLY CARDINAL [0 semaphoreTableSize); 


-- Initialization 


InitializeSemaphoreTable: PROCEDURE; 
InitializeClock: PROCEDURE; 


-- Process-rel a ted primitives 

Primi t IveS ignal : PROCEDURE; 

PrimitiveWait: PROCEDURE; 

PrimitiveResume: PROCEDURE; 

PrimitiveSuspend: PROCEDURE; 

PrimitiveFlushCache: PROCEDURE; 

-- Used by the Interpreter for process switching 
CheckProcessSwitch: PROCEDURE; 


Used by the Interpreter for signalling semaphores 

AsynchronousSignal: PROCEDURE [semaphore: Oop]; 
ReSignal: PROCEDURE; 

SynchronousSignal: PROCEDURE [semaphore: Oop]; 

Needed for snapshot 
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ActiveProcess: PROCEDURE RETURNS [Oop] ; 


-- Clock primitives 

PrimitiveTickWordsTnto 
Prim i tivoTiineWordsInto 
PrimitiveSignalAtTick: 

-- Clock utility 

Kill Tinier: PROCEDURE; 
END. 


PROCEDURE; 
PROCEDURE ; 
PROCEDURE; 
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Package: Process and Clock Primitives. 

~~ last edited by malcolm, 

-- 20--Dec-85 15:33:36 recode without Sleep, Postpone 

-- 20-Dec-85 12:28:13 Addtast, RealReplace 

-- 19~Dec-85 15:58:30 several TNLINEs 

-- 19-f)ec-85 12:29:44 speodups: RemoveFirst and callers 
-- lR-Dee-85 17:00:55 some speodups, incl listCheck 

-- l/-Uec-85 15:24:59 INLINE Schedul erPoi i) ter, In 1 ineAct iveProcess 

-- 8-Oct-86 15:24:04 use ItefD, Re FI 

7-Oct-85 10:53:32 no warnings 
-- B-Sep-85 18:52:43 "G 

-- 29-Aug-86 17:55:52 faster time prims 

29-Aug-85 14:51:50 common. act ive, leaf 

-- 29-Jul-85 16:48:00 Base[Of 

22-Jul-85 15:37:20 PrimitiveFail no arg 

-- 8-Jul-OS 18:10:24 USING for all 

-- 21-Jun-85 16:18:06 no return from Store 

5-Jun-86 11:11:40 import Hum 

4- Jun-85 18:46:14 newProcossWaiting, newProcess in Rum.common 

-- 21-May-85 14:46:08 IsWords in Mem 

-- 20-May-85 10:00:43 STSOStrotch 

-- 16-May-85 17:47:11 tidy up M..sec..Clock, Timer 

-- 18 Apr-85 17:37:55 Stretch compatible IsWords 

5- Apr-85 16:15:43 usual ListlsFullOfCorrectness 
4-Apr-8G 15:14:10 begin Stretch, no isSmall-Integer 

-- 27-Mar-85 17:17:01 ListIsFullOfCorrectness = TRUE 

-- 12-Mar-85 16:41:58 fail in PrimSiganiAt!ick if timerSetting is small int 
-- ll-Mar-85 18:01:02 -Wordslnto should stuff the ARGUMENT! 

-- ll-Mar-85 17:33:42 look at pulses in Mil 1isecondClock 

-- ll-Mar-85 15:28:10 break up long Timer waits 

-- 22-Feb-85 14:40:42 fix DoltaWord use, debug flags in STOODebugflags 

-- last edited by Zdybel , 21-Feb-85 17:40:59 

DIRECTORY 

Inline USING [BITR0TATE, DBITSHIFT, llighllalf, Lowllalf], 

Process USING [Abort, Detach, MsecToTicks, Pause, SetPriority, GetCurrent, 
Milliseconds, licks, InvalidProcess, priorityForeground, 
priorityNormal], 

System USING [PulsesToMicroseconds, GetClockPulses, SecondsSinceEpoch, 
GetGreenwichMeanTiine, Pulses], 

SISODebug USING [LogProcessSwitch], 

STSODebugFlags, 

STSODefs USING [Base, Bletch, classSemaphorePointer, 

DeltaWordFrom, FetchDeltaWord, Loc, nilPointer, 
objectFieldBase, Of, Oop, OopIsSmallInteger, Physical, 

Physical Address, PMemFetch, PMemSmash, PrimitiveFail, RealFetch, RealSmash, 
schedulerAssociationPointer, Sraal1 Integer, VirtualAddress], 

STSOMem USING [associationValuelndex, IsWords, 

FetchByteLength, FetchClass, Fetchlnteger, FetchPointer, 

IntegerObjectOf, IntegerValueOf, objectSizeOffset, 

Pop, QFetchPointer, QSmashPointer, QStoreByte, RefD, RefI, 

SmashPointer, StackAccess, StackTop, TernaryPrimReturn, UnaryPrimReturn], 

ST80Proc USING [AsynchronousSignal, ReSignal, semaphorelndex, suspendedContextlndex, 
activeProcessIndex], 

STSORum USING [common], 

STSOSend USING [InitializeMethodCache, NewActiveContext], 

STSOStretch USING []; 


STSOProcImpI: PROGRAM 

IMPORTS Inline, Process, System, 

ST80Debug, ST80Defs, ST80Mem, ST80Proc, ST80Rum, ST80Send 
EXPORTS ST80Proc = BEGIN 

OPEN ST80DebugFIags, ST80Defs, ST80Proc, ST80Rum, 

DBug: ST80Debug, Mem: STSOMem, Send: ST80Send, Stretch: ST80Stretch; 


Process and clock related registers of the interpreter 


currentTimerProcess: PROCESS «- NIL; 

-- In the DLion, the clock is a "pulses" clock, NOT a millisecond 
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-- clock. A pulse being on the order of microseconds, and the clock 
-- being only two words wide, the DLion's "millisecond" clock wraps 
-- approximately once ovory 34 hours. To get the most out of this 
~~ limited amount, offset tho actual pulses clock by its value when 
-- starting up an image. 

in it ial Pul sos : System. Pu I ses <- NUTT; 

cl ockModu lus : LONG CARDINAL *- Systern.PuIsesToMicrosoconds[ 

LOOPHOLE!' 429496 7295/1.000, System. Pul ses]] ; 


-- Structure of process-related classes defined here 

-- Class ProcessScheduler 

processListsIndex: CARDINAL = 0; 

-- Class LinkedList 

firstL inklndex: CARDINAL = 0; 
lastLinklndex: CARDINAL = 1; 

-- Class Semaphore 

excessSignalslndex: CARDINAL = 2; 

-- Class Link 

nextl.i nklndex: CARDINAL = 0; 

Class Process 

priority Index: CARDINAL = 2; 
inyLis tlndex : CARDINAL = 3; 


Initialization 


InitializeClock: PUBLIC PROCEDURE = 

BEGIN 

-- The Dl.ion "millisecond clock" wraps so frequently it is 
-- best to reset it to zero every time we start a new image. 

ini tialPulses <- System.GetClockPulses[]; 

END; 


--- Process-related primitives: 


Reference counting theory is that any argument of Resume has had 
its reference count temporarily inflated by one. This is mainly 
done to make sure that a process does not go away between the time 
it is removed from some list and the time it actually becomes the 
-- active process. In most of the motivated cases, the inflation is 
done by the routine that removes items from lists. Primi tiveResuine 
-- does it just to be like everybody else. The temporary inflation 
is undone either by Resume or by CheckProcessSwitch. Because there 
are other outstanding references to semaphores, shoving a semaphore 
-- into the semaphore buffer doesn't require similar futzing around 
-- with reference counts. 

PrimitiveSignal: PUBLIC PROCEDURE = 

BEGIN 

-- Used for signalling semaphores from within the (Mesa) process 
-- of the interpreter. 

SynchronousSignal[Mem.StackTop[]]; 

END; 
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Priini tiveWait: PUBLIC PROCEDURE = 

BEGIN 

-- Associated with the wait message) in Semaphore. IT the receiver 
-- has an excess signal count greater than 0, decrements the count. 
-- If the excess signal count is 0, suspends the active Process and 
-- adds it to the receiver's list of Processes. 

receiver: Oop = Mem.StackTopf ]; 

oxcessSigna 1 sRofLoc : Physical Address *■ Loc[Of[recoiver]] 

+ excessSignalsIndex + objectFieI dBase; 
excessSigna I s : Oop <- Real , f etch[excessSignal sRefLoc] ; 
n: Small Integer; 

IF ~0opIsSmallIntoger[excessSignals] THEN PrimitiveFai1j 

IF (n *- Mem. IntegerVal ueOf[excessSignai s]) > 0 
THEN excessSignais remains small integer, so no refents 
RealSmash[excessSignalsRefLoc, Mem. IntogerObjectOf[n - 1]] 

ELSE BEGIN 

-- AddLastLinkTol.ist[Inl ineActiveProcess[], receiver]; 

Add Last[receiver, Ini!inoActiveProcess[]]; 
TransferTo[WakellighestPriority[]] ; -- SuspendActive; 

END; 

END; 


PrimitiveResume: PUBLIC PROCEDURE = 

BEGIN 

receiver: Oop = Mein.StackTop[]; 

-- Inflate tho receiver's rofeount because Resume expects this. 

Mem.Ref I[receiver]; 

Resume[ receiver]; 

END; 


PrimitiveSuspend: PUBLIC PROCEDURE = 

BEGIN 

-- Suspends the receiver if it is the active Process. If the 
-- receiver is not the active Process, the primitive fails. 

receiver: Oop = Mem.StackTop[]; 

IF receiver # IniineActiveProcess[] 

THEN PrimitiveFail; -- [reason; "Suspend Received by Inactive Process"L]; 

TransforTo[WakeHighestPriority[]]; -- SuspendActive; 

Mem.UnaryPrimReturn[ni1 Pointer]; 

END; 


PrimitiveFlushCache: PUBLIC PROCEDURE = 
BEGIN 

Send.InitializeMethodCache; 

END; 


Interface procedure used by the Interpreter for process switching 


CheckProcessSwitch: PUBLIC PROCEDURE = 

BEGIN 

-- Called before each bytecode fetch (in the basic interpreter loop) 
-- to perform the actual process switch if one has been called for. 

-- Stores the active context pointer into the old Process, stores 
-- the new Process in the ProcessorScheduler's active process field, 
-- and loads the new active context out of that Process. Important: 
-- newProcess has had its reference count artificially inflated to 
-- make sure it doesn’t go away inopportunely. Be sure to set things 
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-- to rights when the coast is clear. 

oldActiveProcess: Oop <- NULL; 

IT semaphorelndex it 0 THEN ReSignal[]| 

IF common. newProcessV/aiting 
THEM BEGIN 

common . newProcossWai ti ng <- FALSE; 
o IdActiveProcess +• Ini ineActivoProcess[]; 

Mom. SniashPo i nter[snspendedCo n text Index, oldActiveProcess, 
common.active]; 

Mem.SmashPointer[activoProcessIndex, SchedulorPointer[] , 
common.newProcess]; 

Send,NewActivoCon text[ 

Mom.FetchPointer[suspendedContext Index, common.newProcess]]; 
-- Uninflate the count on newProcess: 

Mem.Re fD[common. newProcess]; 

-- Inserted for debugging purposes 

IF debugFIg THEN Dtiug . LogProcessSwi tch[common . newProcess]; 

END; 

END; 


-- Private process-related procedures 


« 

SuspendActive: PROCEDURE = INLINE 
BEGIN 

Trans ferTo[WakeliighestPriority[]]; 
END; 

>> 


SynchronousSignal: PUBLIC PROCEDURE [semaphore; Oop] = 

BEGIN 

first; Oop = RemoveFirst[semaphore]; 

IF first = nilPointer 
THEN BEGIN 

excessSignalsRefLoc: Physical Address = Loc[Of[seinaphore]] 

+ excessSignalslndex + objectFieldBase; 
excessSignals: Oop «- Real Fetch[excessSignaI sRefLoc]; 
n: Small Integer; 

-- excessSignals must always be Smalllnteger, so no refcnts 
IF OopIsSmal1Integer[excessSignaIs] 

AND (n <- Mem. IntegerVal ueOf [excessSignal s]) < LAST[SmaIi Integer] 
THEN ReaISmash[excessSignaTsRefLoc, Mem.IntegerObjectOf[n + 1]] 
ELSE PrimitiveFail; 

END 

ELSE Resume[first]; -- note that RemoveFirst inflated first's refcnt 
END; 


Resume: PROCEDURE [process: Oop] = BEGIN 

-- This routine assumes that its argument has had its reference 
-- count artificially inflated by one. 

activeProcess: Oop = IniineActiveProcess[]; 

activePriority: CARDINAL = Mem.FetchInteger[priorityIndex, activeProcess]; 
newPriority: CARDINAL = Mem.FetchInteger[priorityIndex. process]; 
processLists; Oop = Mem.FetchPointer[processListsIndex, SchedulerPointer[]]; 
processList: Oop <- NULL; 

IF newPriority > activePriority 
THEN BEGIN 
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-- Wo are unfairly interrupting the current active process. 

Instead of circulating it back to the end of its queue, 

-- push it onto the front. 

- - Pos tpone[activeProcess |; 

processList <- Mem. FetcliPoin tor[ac t.ivePr ior ity - 1, processL is ts] ; 
AddFirstLinkToList[activeProcess, processL ist]; 

-- If nowProcossWait ing was TRUE, we must readjust the 
reference count on activeProcess, wliich will have boen 
-- inflated to make sure it didn't go away. It's ok to do 
-- this now because we have just placed it on a queue. 

IF common.newProcessWaiting THEN Mom.RefD[activoProcess]; 

TransferTo[process]; 

END 

ELSE BEGIN 

-- Add a process onto the back of its quiescent process list. 

--S1 eep[process]; 

processList <- Mem. FetchPoin ter[newPriority - 1, processLists] ; 
AddLast[processList, process]; 

Mem.RefD[process]; -- undo inflation 
END; 

END; 


TransferTo: PROCEDURE [process: Oop] = INLINE BEGIN 

-- ANY process being transferred to will have had its reference 
-- count artificially inflated by one. Note that if the current 
-- activeContext is also the current leafContext, we must make 
-- sure that it does not get recycled. 

common. newProcessWaiting <■ TRUE; 
common . newProcess <• process; 

IF common.1eafContext = common.active THEM 
BEGIN 

-- Make sure to readjust the reference count of the leafContext, 
-- which will have been inflated in order to keep it around, 

Mem.RefD[common.leafContext]; 
common.leafContext «- nilPointer; 

END; 

END; 


WakeHighestPriority: PROCEDURE RETURNS [process: Oop] = BEGIN 

-- Remove a link from the quiescent process list. The link's 
-- count will have been artificially inflated by the list manip- 
-- ulation routine. 

processLists: Oop = 

Mem.FetchPointer[processLists Index, SchedulerPo1nter[]]; 
processListsLoc: Physical Address = Loc[Of[processLists]]; 
processListRefLoc: Physical Address <- processListsLoc -- high priority first 
+ RealFetch[processListsLoc + Mem.objectSizeOffset] - 1; 
processList: Oop <- NULL; 

WHILE (process <- RemoveFirst[processList «- RealFetch[processListRefLoc]]) 

= nilPointer 

DO processListRefLoc <- processListRefLoc - 1 ENDLOOP; 

RETURN[process] 

END; 


« 

Sleep: PROCEDURE [process: Oop] = BEGIN 

-- Add a process onto the back of its quiescent process list. 
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priority: CARDINAI -■ Mem. Fetchlnteger[pr iori tylndex , process]; 
process!, ists: Oop = 

Mem. l-otchPo in tor[processl.istslndex , Scliedu I erPoi nter[ ]] ; 
processList: Oop *• Mem. letchPointer[priori t.y - 1, process!, is ts] ; 

-- AddLas tl.inkTol.ist[process , process!, is t] ; 

AddLas L[processL ist, process|; 

L.MD; 


Postpone: PROCEDURE [process: Oop] = BEGIN 

-- We are changing priority levels; add process back onto the 
-- front of its quiescent process list. 

priority: CARDINAL - Mem. Fetchln teger[pri o ri t.y Index , process]; 
process!, ists ; Oop = 

Mem.FetehPointerfprocessListslndex, SchodulorPointer[]]; 
processList: Oop <- Mem. FetchPo inter[priority - 1, processLists]; 

AddPirstLinkfoList[process , processList]; 

END; 


-- Low level Support for the Above 


IniineActiveProcess: PROCEDURE RETURNS [Oop] = INLINE 
BEGIN 

RETURN[IF common.newProcessWaiting 
THEN common.newProcess 

ELSE Mem.FetchPointer[activeProcessIndex, ScheduierPoIntern 11: 
END; 

ActiveProcess: PUBLIC PROCEDURE RETURNS [Oop] = 

BEGIN 

RETURN[InlineActiveProcess[]]; 

END; 


SchedulerPointer: PROCEDURE RETURNS [Oop] = INLINE 
BEGIN 

RETURN[Mem.FetchPointer[Mem.associationValueIndex, 
scheduierAssociationPoin ter]]; 

END; 


-- LinkedList-related procedures 


« 

RemoveFirstLinkOfList; PROCEDURE [listBase: VirtualAddress] 

RETURNS [link: Oop] = BEGIN 

-- Guaranteed to leave the thing removed with a (hopefully 
-- temporarily) exalted reference count. This routine is 
-- called only when the list is known not to be empty. 

firstLink: Oop = Mem.QFetchPointer[firstLinklndex, listBase]; 
lastLink; Oop = Mem.QFetchPointer[lastLinkIndex, listBase]; 
nextLink: Oop «- NULL; 

-- There is a shortfall in the current Virtual machine design 
-- in that there is no way to guard against the eventuality of 
-- encountering one of these lists while it is in the process 
-- of being modified from the Smalltalk side. No way to recover 
-- once the condition is detected, so break before the object 
--memory is smashed. 

LinksCheck[firstLink, lastLink]; 

-- Make sure the reference count of the link removed will be 
-- one too many. 
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Mom. lief I [f i rstL ink]; 


If lastl.ink - firstlink 
I Ilf N HI GIN 

Mem.QSmashPointer[fi rstLi nklndex, I is tBase , n il Pol n ter] ; 

Mem. QSniash Points r[I as tLinklndex, 1istBase, n i iPointer]; 

END 

ELSE BEGIM 

next!.ink <- Mem.FetchPointor[nextLinklndex, firstL'ink]; 

Mem. QSniashPointer[f i rs tl.i nklndex, 1 i stBase , nex tLink]; 

END; 

Mem.SmashPointor[nextLinklndex, firstLink, ni IPoiivter] ; 

RETURN[firstLink]; 

END; 

>> 

RomoveFirst: PROCEDURE [list: Oop] RETURNS [first: Oop] = INLINE BEGIN 
-- leaves first with refcnt inflated; also allows for empty list 

firstRefLoc: Physical Address = Loc[0f[1 ist]] 

+ objoctEieIdBase + firstLinklndex; 

f irst *■ RealEetch[firstRefLoc]; 

IF first = nilPointer 
THEN RETURN 
ELSE BEGIN 

lastRefLoc: Physical Address = firstRefLoc 
+ lastLinklndex - firstLinklndex; 
last: Oop = RealFetch[lastRefLoc]; 

LinksCheck[first, last]; -- make sure list is consistent 

-- list refs first, so don't refD (hence first ends up inflated) 

-- next merely moves from a ref by first to a ref by list, refcnt same 

IF first = last -- so also next = nilPointer 
THEN BEGIN 

RealSmasli[f i rstRef Loc , nil Pointer]; 

RealSmash[lastRefLoc, nilPointer]; 

Mem.RefD[last]; -- mustn't overinflate 

END 

ELSE BEGIN 

nextRefLoc: PhysicalAddress = Loc[0f[first]] 

+ objectFieldBase + nextLinklndex; 
next; Oop = RealFetch[nextRefLoc]; 

RealSmash[firstRefLoc, next]; 

RealSmash[nextRefLoc, nilPointer]; 

END; 

END; 

END; 


AddFirstLinkToList: PROCEDURE [link: Oop, list: Oop] = 

BEGIN 

listBase: VirtualAddress = Base[Of[list]]; 
linkBase: VirtualAddress = Base[Of[11nk]]; 

-- Check to see if we interrupted a method that was changing 
-- the process list. 

ListCheckfl1st]; 

IF IsEmptyList[listBase] 

THEN Mem.QSinashPointer[lastLinkIndex, listBase, link]; 

Mem.OSmashPointerfnextLinklndex, 1inkBase, 

Mem.QFetchPointer[firstLinklndex, 1 istBase]]; 
Mem.QSmashPointer[firstLinklndex, listBase, link]; 
Mem.QSmashPointer[myL1stIndex, linkBase, list]; 

END; 


« 

AddLastLinkToList: PROCEDURE [link: Oop, list: Oop] = 
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BEGIN 

listBase: VirtualAddress = Base[0f[ I isl ] |; 
linkBase: VirtualAddress - Base[0f[ I ink] j ; 

-- Check to see if we interrupted a method that was changing 
-- the process list. 

ListCheck[ I ist] ; 

IF IsEmptyl.is t[l istBaso] 

THEN Mom. QSmashPo inter[f i rs tLinklndex , 1 i stliase , link] 

ELSE Mom. SmashPoin torf'nox tL ink Index , 

Mem.QFetchPointer[lastLinklndex, 1istBaso], I ink]; 

Mem,QSmashPointer[lastLinklndex, listBaso, link]; 

Mem. QSmashPol nterfnextL inklndex , linkBase, nil Pointer]; 

Mem.QSmashPointer[myListIndex, IinkBase, list]; 

END; 


AddLast: PROCEDURE [list, link: Oop] = BEGIN 

firstRefLoc: PhysicalAddress = Loc[Of[1ist]] 

+ objectFieldBase + firstLinklndex; 

lastRefLoc: PhysicalAddress = firstRefLoc + 1astLinklndex - firstLinklndex; 
first: Oop = Real Fetch[ f i rstRef Loc] ; 
last: Oop = RealFetch[1astRefLoc]; 

1 inkNoxtRe f Lot: PhysicalAddress = Loc[0f[l ink]] 

+ objectFieldBase + nextLinklndex; 

LinksCheck[first, last]; 

IF first = nil Pointer 

THEN RealSmash[firstRefLoc, link] 

ELSE Real Smash[Loc[Of [1 as tj] + objectFieldBase + nextLinklndex, link,]; 

Mem.Refl[link]; 

ReaIReplace[lastRefLoc, link]; 

RealReplace[1inkNextRofLoc , nil Poin ter]; 

RealReplace[linkNextRefLoc +myListIndex - nextLinklndex, list]; 

END; 

IsEmptyList: PROCEDURE [listBase: VirtualAddress] RETURNS [BOOLEAN] = 

INLINE BEGIN 

RETURN[Mein.QFetchPointer[firstLinklndex, listBase] = nilPointer]; 

END; 


IsEinptyListLoc: PROCEDURE [listLoc: PhysicalAddress] RETURNS [BOOLEAN] = 

INLINE BEGIN 

RETURN[Realfetch[IistLoc + firstLinklndex + objectFieldBase] = nilPointer]; 
END; 


LIstlsFuIlOfCorrectness: PROCEDURE [listBase; VirtualAddress] 
RETURNS [BOOLEAN] = 

BEGIN 

-- Check to make absolutely sure that the argument is a valid 
-- list. 

nextLink: Oop <- Mem.QFetchPointer[firstLinklndex, listBase]; 
previous: Oop <- nilPointer; 

WHILE nextLink # nilPointer DO 
previous <- nextLink; 

nextLink *- Mem.FetchPointer[nextLinkIndex, previous]; 
ENDLOOP; 

RETURN[previous = Mem.QFetchPointer[lastLinkIndex, listBase]]; 
END; 


ListCheck: PROCEDURE [list: Oop] = INLINE BEGIN 

loc: PhysicalAddress = Loc[0f[1ist]] + objectFieldBase; 

LinksCheck[RealFetch[loc + firstLinklndex], RealFetch[loc + nextLinklndex]]; 
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END; 


l.inksChoek: PROCEDURE [firstl.ink, lastlink: Oop] = INLIME 
BEGIN 

-- Check to make absolutely sure that we have a valid list. 

previous: Oop <- nilPointer; 

WHILE firstl.ink it nilPointer DO 

linkRefLoc: Physica lAddress «- Loc[Of[fir$l:Link]] 

+ nextLinklndex + objoctfieldilase; 

previous <- firstLink; 

firstLink «- Real Fe tch[l i nkRef Loc] ; 

ENDLOOP; 

IF previous It lastLink THEN Bletch["Process list invalid"G]; 
END; 


-- Clock Primitives 


PrimitiveTickWordsInto: PUBLIC PROCEDURE = 

BEGIN 

-- Stuff the current reading of the millisecond clock into the 
-- receiver, checking first to make sure that the receiver is 
-- roomy enough. 

-- The receiver here is Time class!! ARGUMENT is byteArray 

byteArray: Oop = Mem.StackTop[]; 
byteArrayBase : VirtualAddress *■ NULL; 
classBase: VirtualAddress «- NULL; 
length: CARDINAL <- NULL; 
time; LONG CARDINAL = Mi 11isecondClock[]; 

— currentWord; CARDINAL <- NULL; 

classBase <- Base[Of[Mem.FetchClass[byteArray]]]; 

IF Mem.IsWords[classBase] THEN 

ERROR PrimitiveFail; -- [reason: "Bad receiver for PrimitiveTickWordsInto"L]; 
length *- Mem. FetchByteLength[byteArray]; 

IF length < 4 THEN 

ERROR PrimitiveFail; -- [reason: "Undersized receiver for PrimitiveTickWordsInto"L]; 
byteArrayBase <- Base[0f[byteArray]]; 

PMemSmash[byteArrayBase, Ini ine. BITROTATE[Inl ine . Lowllal f [t ime] , 8]]; 
PMemSmash[byteArrayBase + 1, Ini ine.BITR0TATE[In1 ine. Highlialf[time] , 8]]; 

« 

currentWord <- Ini ine.LowHalf[time]; 

Mem.QStoreByte[0, byteArrayBase, Iniine.LowByte[currentWord]]; 

Mein.QStoreByte[l, byteArrayBase, Inline. II 1gliByte[currentWord]] ; 
currentWord «- Ini ine.HighHalf[time]; 

Mem.QStoreByte[2, byteArrayBase, Iniine.LowByte[currentWord]]; 

Mem.QStoreByte[3, byteArrayBase, Inline.HighByte[currentWord]j; 

» 

FOR index: CARDINAL IN [4..length) DO 

Mem.QStoreByte[index, byteArrayBase, 0]; 

ENDLOOP; 

[] <- Mem.Pop[]; -- return self by popping arg array 
END; 


PrimitiveTimeWordsInto: PUBLIC PROCEDURE = 

BEGIN 

-- Stuff the current reading of the GMT clock into the receiver, 
-- checking first to make sure that the receiver is roomy enough. 

byteArray: Oop = Mem.StackTop[]; 
byteArrayBase: VirtualAddress <- NULL; 
classBase: VirtualAddress «- NULL; 
length: CARDINAL «- NULL; 
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time: LONG CARDINAL = 

Systom. SeconcisS inceCpoch[gmt: System.GetGreenwiciiMeanTime[]] + 

2114294400; 

--currentWord: CARDINAL <- NULL; 

classBaso <- Base[Of[Mem. FetchCl ass[by teArray] |] ; 

IF Mem. IsWords[c lassllase] THEN 

ERROR Primi t iveFail; -- [reason: "Bad receiver for PrimitiveTickWordsInto"L]; 
length <- Mem. FetchByteLeng th[byteArray]; 

IF length < A THEN 

ERROR PrimitiveFail; -- [reason; "Unders ized rece iver for PrimitiveTickWordsInto"L]; 
byteArrayBase *■ Base[0f [byteArray ]] ; 

PMemSmash[byteArrayBase, In i ino . BITROTATE[Inl i ne . Lowllal f [time] . 8] ] ; 
PMemSmash[byteArrayBase + 1, In line . BITROTATE[ Inline . Highilal F[ Lime], 8]]; 

« 

currentWord *- Ini ine . LowFlalf [time]; 

Mem.QStoreByte[0 , by teArrayBase , Inline. Lowf!yte[currentWord]] ; 

Mem.QStoreByte[1, by teArrayBaso, Inline.HighByte[currentWord]]; 
currentWord <- Ini ine.Highlialf[time] ; 

Mein.OSt,oreByte[Z, byteArrayBase , Ini ine.Lov/Byte[currentWord]] ; 

Mem.QStoreByte[3 , by teArrayBase , Ini ine.FIighl5yte[currentWord]] ; 

>> 

FOR index: CARDINAL IN [4..length) DO 

Mem.QStorellyte[ index, by teArrayBase, 0]; 

ENDLOOP; 

[] <- Mem.Pop[]; -- return self by popping arg 
END; 


PrimitiveSignalAtTick: PUBLIC PROCEDURE = 

BEGIN 

-- Arrange for an AsynchronousSigna1 to happen at some specified 
-- setting of the millisecond clock. Be sure that timerSetting is 
-- at least four bytes long. If semaphore is not a Semaphore, 

-- cancel the current timer setting. 

timerSetting; Oop - Mem.StackTop[]; 

timerSettingBase: VirtualAddress = Base[Of[timerSetting]]; 
semaphore: Oop = Mem.StackAccess[l]; 
niessageReceiver: Oop = Mem.StackAccess[2]; 
timerValue: LONG CARDINAL *0; 
nowValue: LONG CARDINAL «- NULL; 

-- Check to see if we have merely been called to abort the current 
-- timer setting. 

IF Mem.FetchClass[semaphore] # classSemaphorePointer THEN 
BEGIN 

-- Suggest to the current timer process that it should abort. 
KillTimer[]; 

Mem,TernaryPrimReturn[messageReceiver]; 

RETURN[]; 

END; 

-- Check out timersetting and make sure it has the right stuff. 

IF OopIsSmal11nteger[timerSetting] 

OR FetchDeltaWord[ 

DeltaWordFrom[timerSettingBase - objectFieldBase]].hasPointers 
OR Mem.FetchByteLength[timerSetting] < 4 
THEN ERROR PrimitiveFail; -- [reason; "Bad clock value"L]; 

-- Get the current timer process to abort. 

KilITimer[]; 

-- Extract the desired clock setting for the next signal. 

timerValue *- Ini ine,DBITSHIFTf 

L0NG[Inline,BITROTATE[PMemFetch[timerSettingBase + 1], 8]], 

16] 

+ LONG[Inline,BITROTATE[PMemFetch[timerSettingBase], 8]]; 
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FOR index: CARDINAL DECREASING IN [0..4) DO 

timerValue «- Ini ino . DU I rSMIFT[ fimerVai ue , 8]; 
timerValue <- In l ine . DBITOIl[timerVa Iue , 

LONG[Mom.QfetchByte[index, timerSott ingliase]]]; 
ENDLOOP; 


-- Some values of the "mil I isecond clock” aro UNOBTAINABLE: the 
-- System pulsos-clock will wrap before these values aro achieved. 

-- Wrap the specified timer setting into the actual range of the 
-- clock. 

timerValue <■• timerValuo MOD clockModulus; 

-- Find out the current setting of the millisecond clock. 

nowValue <- M i 11 isocondC lock[] ; 

IF nowValuo >= timerValuo THEN 

-- The desired time for the signal has already occurred. 

-- Generate the signal immediately. 

SynchronousSignal[semaphore] 

ELSE 

BEGIN 

-- Launch a process that will signal at the desired value of 
-- the millisecond clock. Make sure that it runs at foreground 
-- priority. 

Process.SetPriority[Process.priorityForeground]; 

currentTimerProcess <- FORK Timer[signal: semaphore, at: timerValue]; 
Process.Detach[currentTimerProcess]; 

Process.SetPriority[Process.priorityNormal]; 

END; 

Mem,TernaryPrimReturn[messageReceiver]; 

END; 


-- Time utilities 


MillisecondCiock: PROCEDURE RETURNS [LONG CARDINAL] = 

BEGIN 

pulses: LONG CARDINAL <- System.Ge tClockPul ses[] . pul ses 
- initialPulses.pulses; 
returnValue: LONG CARDINAL *- 

System. PulsesToMicroseconds[LOOPIiOLE[puI ses/1000, System. Pulses]] 

+ (System.PulsesToMicroseconds[LOOPHOLE[puIses MOD 1000, System.Pulses]] 
/ 1000 ); 

RETURN[returnValue]; 

END; 


Timer: PROCEDURE [signal: Oop, at: LONG CARDINAL] = 

BEGIN 

nowValue: LONG CARDINAL *- Mill isecondClock[] ; 

WHILE nowValue < at DO 

msec: LONG CARDINAL <- at - nowValue; 

msecToWait: Process .Mill iseconds <- LOOPHOLE[Inl ine. Lowllal f[msec]]; 
ticksToWait: Process.Ticks ♦- Process.MsecToTicks[msecToWait]; 
Process.Pause[ticksToWait ! ABORTED => GO TO Aborted]; 

-- Suspenders and belt. If this global doesn't point to us, 

-- a signal is definitely not wanted from us ever. 

IF currentTimerProcess it Process.GetCurrent[] THEN RETURN[]; 

nowValue <- Mil 1 isecondClock[]; 

ENDLOOP; 

AsynchronousS ignal[signal]; 
currentTimerProcess *■ NIL; 

RETURN[]; 
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EXITS Aborted = > 

BEGIN 

current.TimerProcoss *■ NIL; 
IU IIJHN| |; 

END; 

END; 


KillTimer: PUBLIC PROCEDURE = 

BEGIN 

If currentTimerProcess // NIL THEM 

Process . Abo rt| cur rent! i me r Process ! 
Process.InvalidProcess => CONTINUE]; 

END; 


-- local inlines for speedup 

<< 

SmashPointer: PROCEDURE [fieldlndex: CARDINAL, oop: Oop, va'IuePointer: Oop] 
= INLINE { 

loc: Physical Address = Loc[0f[oop]] + (objectFieI dBase + fieldlndex); 
Mem,RefD[RealFetch[loc]]; --DocreaseReferences 
Real Sinash[T oc , valuePo inter] ; 

Mom.Reri[valuePointer] }; --IncreasoReferencas 

QSmashPointer: PROCLDURE 

[f ieldlndex: CARDINAL, base: VirtualAddress, va'IuePointer: Oop] 

= INLINE { 

loc: PhysicalAddress = Physical [base + fieldlndex]; 

Mem,RefD[RealFetch[loc]]; --DecreaseReferences-- 
RealSmash[loc, valuePointer]; 

Mem.RefI[vaIuePointer] }; --IncreaseReferences-- 


RealRepIace; PROCEDURE [loc: PhysicalAddress, value: Oop] 
= INLINE BEGIN 

Mem.RefD[ReaIFetch[loc]]; 

RealSmash[Ioc, value]; 

Mem.Refl[value]; 

END; 


END. 
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{ BBT.dfn 

Definitions for bitbit in Rum, the Dandelion Smalltalk-80 mlcrocoded virtual machine, 
by T Tokunaga, J Trow 
9-Feb-86 17:33:52 


Copyright 1985, 1980 by Xerox Corporation. All rights reserved. } 


{ R, RH register } 


RegDef [sourcelndex. 

R. 

°3; 

RegDef [skew. 

RH, 

0]i 

RegDef [destAddrlow, 

R. 

i]i 

RegOef [destAddrHIgh, 

RH, 

1]: 

RegDef [sourceAddrLow, 

R, 

z]: 

RegDef [sourceAddrHIgh, 

RH, 

23: 

RegDef [halftoneAddrLow, 

R, 

4]i 

RegDef [halftoneAddrHigh, 

RH, 

43: 


{ U register } 


{ ******** Mesa Stack ***** 
RegDef [uDestBItMap, 

RegDef [uH, 

RegDef [ul, 

RegDef [uDestAddrLow, 

RegDef [uDestWIdthA. 

RegDef [uDestAddrHIgh, 
RegDef [uDestHelghtA, 

RegDef [uDestDelta, 

RegDef [uMaskl, 

RegDef [uMask2, 

RegDef [uSkewMask, 

RegDef [uCurrentDIspBItMap, 
RegDef [uMlsc, 

RegDef [uHalftoneAddrLow, 
RegDef [uSourceAddrLow. 
RegDef [uSaveHlghAddr, 
RegDef [uNWordsMl, 

{•«*** + ***** u block t ***** 

RegDef [uSaveIPL, 

RegDef [uSavelPH, 

RegDef [uSaveStackL, 

RegDef [uSaveStackH, 

RegDef [uSaveHomeL, 

RegDef [uSaveHomeH, 

RegDef [uArgument, 

(********** u block 2 ***** 
RegDef [uSourceDelta, 

£********** y bl0Ck 3 ***** 
RegDef [uClIpHelght, 

RegDef [uDestMap, 

RegDef [uCHpWldth, 

RegDef [uBBTTemp, 

RegDef [uStartBIts. 

RegDef [uCllpY, 

RegDef [uW, 

RegDef [uDX, 

RegDef [uBooleans, 

{*•****««** y block 4 ***** 

RegDef [uComblnatlonRule, 
RegDef [uDestForm, 

RegDef [uSourceForm, 

RegDef [uSX, 

RegDef [uHalftoneForm, 
RegDef [uOestX, 

RegDef [uDestY, 

RegDef [uSkawWord, 

RegDef [uSourceX, 

RegDef [uPrevWord, 

{********** y block 5 ***** 
RegDef [uDY, 

RegDef [uVDlr, 

RegDef [uHDIr, 

RegDef [uSY. 

RegDef [uHalftoneWord, 

£********** y b1ock Q ***** 

RegDef [uSourceY, 

RegDef [uMergeMask, 

RegDef [uDestWldth, 

RegDef [uWord, 

RegDef [uDestHelght, 

RegDef [uNWords, 


u, 

21 

u, 

3| 

u, 

3| 

u, 

4| 

u, 

41 

u. 

si 

u. 

51 

u, 

6 1 

u, 

n 

u. 

8| 

u, 

91 

u, 

91 

u. 

OAJ 

u, 

OB] 

u, 

OC 1 

u, 

OD] 

u, 

0E3 

** 

> 

u, 

14' 

u, 

17’ 

u, 

19' 

u, 

iAi 

u, 

19 1 

u, 

ID 1 

u, 

IE] 

** 

> 

u, 

24] 

** 

> 

u, 

311 

u, 

31 1 

u, 

341 

u, 

34] 

u, 

35 J 

u, 

35 j 

u, 

37 

u, 

38 j 

u, 

3CJ 

** 

> 

u. 

42 | 

u, 

43 | 

u. 

44 | 

u. 

47 | 

u. 

4BJ 

u, 

4C| 

u. 

40 | 

u, 

46 | 

u. 

4F 1 

u, 

4F3 

** 

1 

u. 

bb | 

u, 

S3 j 

u, 

5C] 

u. 

5D| 

u. 

5D] 

** 

> 

u. 

83 | 

u. 

83 j 

u. 

6A| 

u, 

BA | 

u. 

6BJ 

u, 

0B] 


{ save Smalltalk Instruction pointer } 

{ save Smalltalk stack pointer } 

{ save Smalltalk home context pointer } 
{ comblnatln Rule } 
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RegDef [uCHpX, 
RegDef [uHMl, 


U, 6D]; 
U, 6F]: 


{ ************************************************************* 

* + 'K * * * + + * * constant ********** 

************************************************************* } 


Set [CSBforCursorHIgh, 
Set [CSBforCursorLow. 

Set [destFormlndex, 

Set [dlffDFAndHF, 


2 ]; 

0F0]; 

f 1rstFleldOfObject]; 

2 ]; 


Set [dlffCurrentBItMapAndCursor, Sub [cursorBItmapOopOffset, dlsplayBItmapOopOffset]]; 
Set [halftoneFormIndex, Add [flrstFleldOfObject, 2]]; 

Set [dlfFleldAndSIze, Sub [flrstFleldOfObject, sIzaFleldOffset]]; 

Set [f1rstFleldOfObjectMl, Sub [flrstFleldOfObject, 1]]; 


{ gotSTFormMapBasa : 12 } 

Set [getDestBitsAfterMInt, 0 ]; 

Set [getDestBIts, 1]; 

Set [getSourceBlts, 2]; 

Set [forniMapBaselndex, flrstFleldOfObject]; 

Sat [formMapBItsNoIndex, Add [1, flrstFleldOfObject]]; 

Set [formBItsIndex, flrstFleldOfObject]; 

Set [formWIdthlndex, Add [1, formBItsIndex]]; 

Sat [formHelghtlndex, Add [1, formWIdthlndex]];; 


chacKSmalllnt: LI} 

Set [checkComblnationRule, 

0 ] 

Set [checkDestX, 

1 ] 

Set [checkDestY. 

2 

Set [checkDestWldth, 

3' 

Set [checkDestHeight, 

4' 

Set [checkSourceX, 

5' 

Set [checkSourceY, 

6 ‘ 

Set [checkCHpX, 

7] 

Set [checkCllpY, 

8 ] 

Set [checkCUpWldth, 

9] 

Set [checkClIpHelght, 

OA] 

Set [checkSourceFormHelght, 

OB' 

Set [checkSourceFormWldth, 

OC 

Set [cursorWIdth, 

OD' 

Set [getWidth, 

0E‘ 

Set [cursorWldthl, 

OF' 

chackSmal1Int2: 11} 

Set [checkDestFormWIdth. 

0 ] 

Set [checkDestFormHeight, 

1 ] 

Set [getWidth, 

2 ] 

Set [getHelght, 

3] 


[chockWIdthAndHelght; L3 } 


Set [checkCllp, 

0 ] 

Set [checkDest, 

1 ] 

Set [checkSource, 

2 ] 

ghtMasks} 

Set [getMasklAgaln, 

0 ] 

Set [getMask2Aga1n, 

1 ] 

Set [getMaskl, 

2 ] 

Set [getMask2, 

3] 

Set [computeSkewMasks. 

4] 

tlply: L3} 

Set [getSourceHul, 

0]t 

Set [getDestMul, 

1]: 

Set [wldthAndHelght, 

2]l 


(getSeveralMasks get skew, maskl, mask2} 

Set [getMasks, 0]; 

Set [getMasksAgaln, 1]; 


{checkFormNIl} 

Set [checkSourceFormAgaln, 0]; 

Set [checkHalftoneFormAgaln, 1]; 


(bltBBTShlft} 

Set [bltShlftSkewP, 0]; 

Set [bltShlftSkewM, 1]; 
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{checkMInt} 

Set [bbtCheckMInt, 0]; 


{updateCursor} 

Set [cursorAndDest, 0]; 

Set [cursorAndSource, 1]; 


{restoreStatus} 

Set [bltbltFInlshed, 

Set [bltbltNotFInished, 
Set [prlmFai1, 

Set [noTransfer, 


{must be odd} 


{ checkRange: L2 } 

Set [checkXRange, 0]; {must be even} 

Set [checkYRange, 1]; {must be odd} 


{ealSkewWord: L3 } 

Set [skewWord, 0] 
Set [skewWordl, 1] 
Set [combOD, 2] 


{write; L2 } 

Set [combODOl, 
Set [comb0002, 
Set [comb0D03, 
Set [combOD04, 
Set [combODOe, 
Set [comb0D07, 
Set [combODOB, 
Set [combODOg, 
Set [combODOB, 
Set [combODOC, 
Set [combODOD, 
Set [combODOE, 



{mergeSrcAndDest: L2 } 


Set [hPISFormNI1, 

i] 

Set [hPlNolast, 

0 ] 

Set [hPlNoLastSFNonNII, 

2 ] 

Set [hMlSFormNIl , 

S] 

Set [hMlNoLast, 

4 ] 

Set [hMlSFormNonNH , 

9 ] 

Set [hMlNoLastSFNonNIl, 

8 ] 

Set [hPlSFormNonNI1 , 

OD] 


{ Edit history; 

22-Jan-88 15:41:19 Tokunaga.fx add constant for checksmallInti, checkWIdthAndHelght } 
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{ BUT.me 

Bltlilt primitive for Rum. the Dandelion Smalltalk-80 mlcrocoded virtual machine, 
by T Tokunaga, M Sakaklbara, J Trow 
g-Feb-86 10:16:57 

Copyright 1985, 1988 by Xerox Corporation. All rights reserved. } 


{ <prim1t1ve: 96> BltBIt » copyBIts 


Perform the movement of bits from one Form to another described by the Instance variables of the receiver. Fall If any instance 
variable Is not of the right type (Integer or Form) or If comblnationRule Is not between 0 and 15 Inclusive. Set the variables 
and try again (BltBl t»copyBltsAga1n). 

1 nput: 


output: 


smash: } 

prlmltlveCopyBIts: 

uSaveIPL IpLow, 

IpLow IpHIgh , 
uSavelPH IpLow, 

uSaveStackL stackLow, 
stackLow stackHIgh, 
uSaveStackH stackLow, 

uSaveHomeL homeLow, 
homeLow homeHIgh, 
uSaveHomeH homeLow, 

checkMesaStackP: 

Xbus ErrnIBnStkp, XDIsp, 

DISP4 [bltBltHowBIgStack, 7], 

stackLow uSaveStackL, GOTO [normalEntry], 


cl: 
c2; 

c3: { save Smalltalk Instruction Pointer } 

cl; 
c2: 

c3: { save Smalltalk Stack Pointer } 

cl: 

c2; 

c3j { save the Pointer to home context } 


cl; { X [12-15] -stackP} 

c2; { Only for case of Mesa Int } 

c3, at [OF, 10, bltBltHowBIgStack]; 


c ----— 

After Mesa Interrupt - 

.— -- > 


[At this point, part of the Parameters of Smalltalk BitBlt are stored In following order } 


Qop for bltblt Argument 

| uDestBltMap 

i 

U02 

Loop counter (Vertical) 

1 ul 

i 

U03 

Destination Address(low) 

| uDestAddrLow 

i 

U04 

Destination Address(hlgh) 

| *uDestAddrH1gh 

i 

U05 

uSource, Dest Delta 

| *uDestDelta 

i 

U08 

uMaksl 

| Maskl 

i 

U07 

uMask2 

| Mask2 

i 

U08 

uSkewMask 

| skewMask 

i 

U09 

uMIsc 

j *Misc 

i 

UOA 

uNWords 

| NWords 

i 

U08 

uHalftoneAddrLow 

| HalftoneAddrLow 

i 

UOC 

uSourceAddrLow 

j SourceAddrLow 

i 

UOD 

uSaveHlghAddr 

j + SaveH1ghAddr 

i 

UOE 


*4********** U DestAddrH1gh 

00-03 : unused 

04-07 : comblnationRule 

08-15 : destination Address high 

*+*«**++**** uMIsc 

00-03 : DY's Offset( LS Nibble) 

04-07 : skew 

08 : unused 

09 : vDIr = -1? 

OA : hDIr = -1? 

OB : unused 

OC : skew = 0? 

OD : halftoneFormNIL -- 1 -> halftonaForm = Nil, 0 -> halftoneForm nonNIl 

OE : sourceFormNIL — 1 -> sourceForm a Nil, 0 -> sourceForm nonNIl 

OF : preload -- 1 -> preload True(uPreload=al1 1), 0 -> preload False(uPreload=0) 
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****+fl****++**** uSaveHighAddr 

00-07 : High address of Source bltMap 

08-OF : High address of Halftone bitmap 

*«********+**«+* u oestDeita 
00-07 : source Delta 

08-0F : dest Delta 

Note : it means that these parameters without * marking Is used for calculating the parameter again used In copyLoop 


{ Now, We calculate the parameter(maskl, Mask2, skewMask, skew, vDIr, 

aftarMesalnti 

temp2Low uMIsc, XwdDisp, 

aftarMesalnti: 

Q 1, DISP2 [checkDIrMInt], 


[vDIr ■ hDIr a 1} 
uVDIr Q, 

uHDIr Q, GOTO [checkSkew], 


(vDIr ■ 1, hDIr = -1 } 

uHDIr tamp2Low xor ~temp2Low, 
uVDIr Q, GOTO [checkSkew], 


[vDIr * -1. hDIr - 1} 
uHDIr Q, 

uVDIr temp2Low xor ~temp2Low, GOTO [checkSkew], 


{vDIr -1, hDIr » -1} 

uVDIr temp2Low xor ~temp2Low, 
uHDIr temp2Low xor ~temp2Low, 

checkSkew: 

tempSLow temp2Low and OF, YDIsp, 

Oc-OF: booleans} 
uBooleans temp3Low, 

BRANCH [skewNonZeroAfterMInt, skewZeroAfterMInt, 7], 


hDIr, preload) used in copybit Loop, again. } 
c3, at [07, 10, bltBltHowBIgStack]; 
cl; 

c2, at [0, 4, checkDIrMInt]; 
c3 *, 

c2, at [1, 4, checkDIrMInt]; 
c3; 

c2, at [2, 4, checkDIrMInt]; 
c3; 

c2, at [3, 4, checkDIrMInt]; 
c3; 

cl; [temp2Low = 00-03;0Y, 04~07:skew, 09:hd1r, 0A:vD1r, 
C2; 


skewNonZeroAfterMInt: 

sourcelndex temp2Low LRot8, 


c3; 


sourcelndex sourcelndex and OF, 
skew sourcelndex LRotO, 

GOTO [checkForm], 


cl; 

c2; [restore skew) 
c3; 


SkewZeroAfterMInt: 
skew 0, 


c3; [restore skew} 


checkForm: 

temp3Low uDestDelta, XLDIsp, cl; 

destAddrLow temp3Low and OFF, BRANCH [destDeltaP, destDeltaM, 1], c2; 


destDeltaM; 

destAddrLow destAddrLow xor -OFF, 

Noop, 

Noop, 

destDeltaP: 

uDestDelta destAddrLow, 


c3; [ create minus value for destDelta} 

cl; 
cZ; 

c3; [DestDelta} 


Xbus uBooleans, XDIsp, cl; 

sourcelndex uSaveHighAddr, DISP4 [checkFormNII, 9], c2; 


[both nonNIl} 
bothNonNIl: 

templHIgh sourcelndex LRotO, 

templLow uHalftoneAddrLow, 
temp2Low temp2Low LRot4, 
uDY temp2Low, 

restoreSAddr: 

otLow sourcelndex LRot8, 
sourceAddrHIgh otLow LRotO, 
sourceAddrLow uSourceAddrLow, 

restoreSDelta: 

temp3Low temp3Low LRotS, XLDIsp, 

temp3Low temp3Low and OFF, BRANCH [sourceDeltaP, sourceDel 


sourceDeltaM: 

temp3Low temp3Low xor -OFF, GOTO [sourceDeltaPl], 


c3, at [9, 10, checkFormNI1]; [hlghaddress of halftone} 

cl; [low address of halftone form} 
c2; 

c3; [save dy's offset} 


cl; 

c2; [hlghaddress of source} 
c3; [low address of source Form } 


cl; [ check sourcaDelta < 0} 
1 ], c2; 


c3; 
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sourceDeltaP: 

Noop, c3; 

sourceDeltaPl: 

uSourceDelta temp3Low, cl; { sourcaOelta} 

sourceAddrLow sourceAddrLow + temp3Low, GOTO [bothNi1AfterMInt], c2; 


{SForm»n11, HForm a nonN11} 
sNIlhNonNI1: 


templHIgh 

sourcelndex LRotO, 

c3, 

at [OB, 10, checkFormNIl]; 

templLow 

uHalftoneAddrLow, 

cl; 

{ halftone form address} 

temp2Low 

temp2Low LRot4, 

c2; 

temp2Low 

temp2Low and OF, 

c3; 


uDY tamp2Low, GOTO [bothNIlAftsrMIntl], 

cl; 

{dy’s offset} 


{SForm=nonN11, HForm=n11} 
sNonNIlhNIl: 

GOTO [restoreSAddr], c3, at [OD, 10, checkFormNIl]; 


{both nil} 
bothNIlAfterMIntl: 

Noop, c2: 

bothNIlAfterMInt: 

otLow uDestAddrHigh, c3, at [OF, 10, checkFormNIl]j {otLow a destdelta} 


destAddrHIgh otLow LRotO, cl; 
otLow otLow LRot8. c2; 
uComblnatlonRule otLow, c3; 


goVLoopMInt: 

otLow uDestAddrLow cl; {otLow=destdelta} 

destAddrLow destAddrLow + otLow, Xbus uBooleans, XDlsp, 

L2 bbtCheckMInt, GOTO [startVLoopl], c2; { restore destination address (16 bit)} 


{ 

- First Entry for Smalltalk Bltblt 


} 

normalEntry: 

MAR [stackHIgh, stackLow + 0], 

LI getParameter, 

otLow MD. CALL [otMap2BankO], 

normalEntryl: 

templLow templLow + f1rstFleldOfObject, 
the destlnatlonForm } 
uArgument otLow, 

Q nllPoInter, 

{ Now get the BIlBlt Argument } 
normalEntry2: 

MAR [templHIgh, templLow + 0], 
templLow templLow + 1, 
destAddrLow MD, 


normalEntry3: 

MAR [templHIgh, templLow + 0], 
templLow templLow + 1, 
sourceAddrLow MD, 

normalEntry4: 

MAR [templHIgh, templLow + 0], 

templLow templLow + 1, LI checkComblnatlonRule, 

otLow MD. 

**♦*+***+*} 

[] otLow and nonPolnterMask, ZeroBr, 

[] destAddrLow and nonPoInterMask, ZeroBr, 

BRANCH [$, halftoneNonOop], 

[] sourceAddrLow and nonPoInterMask, ZeroBr, 
BRANCH [$, destlnatlonNonOop], 


cl; 
c2; 

c3; { get the real address of object } 


cl, at [getParameter, 10, otMap2BankO-return]; { Point 

c2; { save the original Oop } 
c3; 


cl; 

c2; { point the SourceFarm } 

c3; { get destination Form ****** } 


cl: C.} 

c2; { point the halftoneForm } 
c3; { get source Form ******** } 

cl; {**+***+***} 

c2; { point the comblnatlonRule } 

c3; { get halftoneForm and check three Oop of Form 

cl; 
c2; 
c3; 


normalEntry5: 

MAR [templHIgh, templLow + 0], BRANCH [$, sourceNonOop], 
uDestForm destAddrLow, CALL [checkSmal1Int], 

normalEntry55: 

[] temp2Low and -OF, ZeroBr, 

BRANCH [combinationRuleTooBIg, $], 

Noop, 

normalEntry6: 

MAR [templHIgh, templLow +0], LI checkDestX, 
uComblnatlonRule temp2Low, CALL [checkSmal!Int], 


cl; 

c2; {save destination Form } 


cl, at [checkComblnatlonRule, 10, checkSmallInt-return]; 
c2; 
c3; 


cl; 

c2; 


BBT.me 


9-Feb-86 13:16:58 PST 


3 









normalEntry7: 

MAR [templHIgh. templLow + 0], LI checkDestY, 
uDestX temp2Low, CALL [checkSmalllnt], 

normalEntryfi; 

MAR [templHIgh, templLow +0], LI checkDestWIdth, 
uDestY temp2Low, CALL [checkSmalllnt], 

norma1Entry9i 

MAR [templHIgh, templLow + 0], LI checkDestHeight, 
uDestWIdth temp2Low, CALL [checkSmalllnt], 

normalEntrylO: 

MAR [templHIgh, templLow + 0], LI checkSourceX, 
uDestHelght temp2Low, CALL [checkSmalllnt], 

normalEntryll: 

MAR [templHIgh, templLow + 0], LI checkSourceY, 
uSourceX temp2Low, CALL [checkSmalllnt], 

normalEntryl2: 

MAR [templHIgh, templLow + 0], LI checkClipX, 
uSourcaY temp2Low, CALL [checkSmalllnt], 

normalEntryl3: 

MAR [templHIgh, templLow +0], LI checkClIpY, 
uClIpX temp2Low, CALL [checkSmalllnt], 

normalEntryl4: 

MAR [templHIgh, templLow + 0], LI checkClIpWldth, 
uCHpY temp2Low, CALL [checkSmalllnt], 

normalEntryl5: 

MAR [templHIgh, templLow +0], LI checkClipHelght, 
uCHpWldth temp2Low, CALL [checkSmalllnt], 

normalEntrylB: 

[] sourceAddrLow - Q, 

[] otLow - Q, ZeroBr, 


cl, at [checkDestX, 10, checkSmal1Int-return]; 
c2; 


cl, at [checkDestY, 10, checkSmal!Int-return]; 
c2; 


cl, at [checkDestWIdth, 10, checkSmallInt-return]; 
c2; 


cl, at [checkDestHeight, 10, checkSmalllnt-return]; 
c2; 


cl, at [checkSourceX, 10, checkSmalllnt-return]; 
c2; 


cl, at [checkSourceY, 10, checkSmalllnt-return]; 
c2; 


cl, at [checkClipX, 10, checkSmalllnt-return]; 
c2; 


cl, at [checkCUpY, 10, checkSmalllnt-return]; 
c2; 


cl. at [checkClIpWldth, 10, checkSmalllnt-return]; 
c2; 


cl, at [checkClIpHeIght, 10, checkSmalllnt-return]; 
c2; 


ZeroBr, {Q : nllPoInter} 

BRANCH [sourceFormNonNIlXX, sourceFormNilXX], 


sourceFormNonNUXX: 

destAddrLow 


0, BRANCH [hal ftoneFormNonNUXXl, halftoneFormNUXXl] , 


c3; 


sourceFormNilXX; 

destAddrLow 


2, BRANCH [halftoneFormNonNUXXl, halftoneFormNIlXXI] , 


c3; { halftoneform » nil } 


hal ftoneFormNonNUXXl: 

GOTO [saveOop], 


cl; 


halftoneFormNUXXl: 

destAddrLow destAddrLow or 4, GOTO [saveOop], 


cl; { sourceForm 3 nil } 


saveOop; 

uBooleans destAddrLow, c2; {save the boolean, so far sourceformNIl, 

halftoneformNII) 

Q uCHpHeight temp2Law, c3; {save clIpHleght} 


normalEntryl7: 

uSourceForm sourceAddrLow, 
uHalftoneForm otLow, 


cl; {save sourceForm) 
c2; {save halftoneForm) 


{ {******************* debug ******. 

LI 1, c3; 

checkDebug: 

LIDIsp, cl; 

BRANCH [$, normalEntryl8, OE], c2; 

L2 prlmFall, GOTO [prlmitlveFallB1tBltl], c3; 

ft****************** debug *******•**•***•***•*****+**********) } 


{If destW1dth<=0 OR destHe1ght<=0 OR cl1pW1dth<=0 OR cl1pHelght<=0 

normalEntryl8; 

[] temp2Low - 1, NegBr, 

temp2Low uClIpWldth, BRANCH [$, clIpHeightLessO], 

[] temp2Low - 1, NegBr, 

temp3Low uOestWIdth, BRANCH [$, clIpWldthLessO], 
normalEntryl9: 

temp3Low temp3Low - 1, NegBr, L3 checkClip, 

{ In Height, we check whether the area slze(w1dth*he1ght) Is greater 
{ Q ; height, temp2Low : Width, NOTE temp2Low, Q, sourcelndex, 

otLow uDestHelght, 

BRANCH [{CALL} checkWIdthAndHelght, destWIdthLessO], 
otLow otLow - 1, NegBr, 


IEN Immediately Return, Nothing Is done } 

c3; { check cllphelght <» 0 } 

cl; 

c2; { check clIpWldth <= 0 } 
c3; 

cl; 

than 64040?. If It Is true. It cause a primitive fall } 
templLow is smashed in the routine } 

c2; 

c3, at [checkCHp, 10 , checkWIdthAndHelght-return]; 
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norma!Entry20: 

BRANCH [$. destHalghtLessO], 

otLow uDestForm, LI getDestFormOata, 

CALL [otMap2BankO], 

getDestlnatlon: 

MAR templLow [templHIgh, templLow + fIrstFleldOfObject]. 
getDeatlnatlonX: 

templLow templLow + 1, BRANCH [noPCGetDest, yesPCGetDest, 1], 


yesPCGetDest: 

templLow templLow + OFF, 

MAR [templHIgh, templLow + 0], GOTO [getDestinationX], 


noPCGetDest: 

sourcelndex MD {destination bitmap}, 

getDestlnatlonl: 

temp3Low uRumRecordLow, 

temp3H1gh uRumRecordHIgh, 

temp3Low temp3Low + dlsplayBItmapOopOffset, 

gatl)est1nat1on2: 

MAR [temp3H1gh, temp3Low + 0], 

[] sourcelndex and nonPointerMask, ZeroBr, 
uDestBItMap sourcelndex, temp3Low MD {display bitmap}, 
BRANCH [$, destlnatlonFormNonOop], 

getDest1nat1on3: 

[] temp3Low xor sourcelndex, ZeroBr, 

uCurrentDIspBItMap temp3Low, 

BRANCH [noDestAndCurrent, yesDestAndCurrent], 


{ destAddrLow = uBooleans } 
yesDestAndCurrent: 

temp3Low 3, 

yesDestAndCurrentl: 

temp3Low temp3Low LRot8, 
temp3Low temp3Low or 28, 
uDestHelghtA temp3Low, 

yesDestAndCurrent2: 

tamp3Low 4, 

temp3Low temp3Low LRot8, 
uDestWIdthA temp3Low, 

yesDestAndCurrent3: 

destAddrLow destAddrLow + 80, 
GOTO [noDestAndCurrent31], 


noDestAndCurrent: 

templLow templLow +1, { Point the Form.Width } 

noDestAndCurrentl: 

MAR [templHIgh, templLow + 0], LI checkDestFormWIdth, 

CALL [checkSmaTIInt2], 

{templLow points the Height, since It Is incremented by 1 In checkSmal 
noDestAndCurrent2: 

MAR [templHIgh, templLow + 0], LI checkDestFormHelght, 
uDestWIdthA temp2Low, CALL [checkSmal!Int2], 

noDestAndCurrent3: 

uDestHelghtA temp2Low, L3 checkDest, 

Q uDestWIdthA, CALL [checkWIdthAndHelght], 
noDestAndCurrent31: 

uBooleans destAddrLow, GOTO [clIpRangel], 


destlnatlonFormNonOop: 

L2 primFail, GOTO [prlmitiveFa11B1tBlt2], 


cl; 
c2 j 
c3; 


cl, at [getDestFormOata, 10, otMap2BankO-return]; 
c2; 


c3; 
cl; 


c3; { get Form BltMap Oop } 


cl; 
c2; 

c3: { point the current display BltMap Oop } 


cl; 

c2; { save the destination BltMap Oop } 
c3; [ get current display BltMap Oop } 


cl; [dest bitmap = current display bitmap? *++*****} 


c2; 


c3; 


cl: 

c2; [ 808 1 d } 
c3; 


cl; 

c2; { 1024 1 d } 
c3; 


cl; 
c2; 


c3; 


cl: 
c2; 

Int2 routine } 

cl, at [checkDestFormWIdth, 10, checkSmal1Int2-returnl; 
c2; 


cl, at [checkDestFormHelght, 10, checkSmal! Int2-return"i; 
c2; 

c3, at [checkDest, 10, checkWIdthAndHelght-return]; 


cl; 


( 


ClIpRange 


{First of all, we check, the X-coordinate } 
clIpRangel: 

Noop, 

sourceAddrLow uSourceX, 
destAddrLow uDestX, 


} 


cl; 
c2; 
c3: 


clIpRange: 

sourcalndex uDestWIdth, cl; 

temp2Low uCHpX, L2 checkXRange, c2; 
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teinp3Low uCHpWldth, CALL [bbtCheckRange] 


c3; 


savaX: 

uSX sourceAddrLow, 
uDX destAddrLow, 

uW sourcelndex, NegBr, 
cheokRangellpY: 

sourceAddrLow uSourceY, BRANCH [wldthGEO, wldthLTO], 


wldthGEO: 

dastAddrLow uDestY, 
tamp2Low uCHpY, 

sourcelndex uDestHelght, L2 checkYRange, 
temp3Low uClipHelght, CALL [bbtCheckRange], 

savoY: 

uH sourcelndex, NegBr, LI getSFormWH, 

uDY destAddrLow, BRANCH [helghtGEO, heightLTO], 


helghtGEO: 

Xbus uBooleans, XDIsp, 

uSY sourceAddrLow, BRANCH [sFormNonNI10, sFormNilO, OD], 


sFormNonNIlO: 

otLow uSourceForm, CALL [otMap2BankO], 
sFormNonNIlOl: 

templLow templLow + formHelghtlndex, 
sourceAddrLow sourceAddrLow + sourcelndex, 
sourcelndex sourcelndex - sourceAddrLow, 

sFormNonNn02: 

MAR [templHIgh, templLow + 0], LI checkSourceFormHelght. 
templLow templLow - 2, CALL [checkSmallInt], 
by 1 In checksmalllnt } 

sFormNonNil03: 

[] temp2Low - sourceAddrLow, NegBr, 

(sy + h > sourceForm height??} 
sourcelndex sourcelndex + temp2Low, 

BRANCH [sFormHelghtGE, sFormHelghtLT], 


sFormHelghtGE: 

GOTO [checkWIdth], 


sFormHelghtLT: 

uH sourcelndex, 

{- next : check width -} 

checkWIdth: 

sourceAddrLow uSX, 
sourcelndex uW, 

sourceAddrLow sourceAddrLow + sourcelndex, 
checkWIdthl: 

MAR [templHIgh, templLow + 0], LI checkSourcoFormWIdth, 
sourcelndex sourcelndex - sourceAddrLow, CALL [checksmalllnt], 

checkW1dth2: 

[] temp2Low - sourceAddrLow, NegBr, 

{ sx +■ w > sourceForm width ??} 
sourcelndex sourcelndex + temp2Low, 


c2, at [checkXRange, 10, bbtCheckRange-return]; 
c3; 

cl; { w < 0? } 
c2; 


c3; 

cl; 
c2: 
c3; 


c2, at [checkYRange. 10, bbtCheckRange-return]; 
c3; 


cl; 
c2; 


c3: 


cl, at [getSFormWH, 10, otMap2BankO-return]: 

c2; { sy + h } 

c3: { h h - (sy + h)} 


cl: 

c2; { point the form width, -2 since templLow Incremented 


cl, at [checkSourceFormHelght, 10, checkSmallInt-return]; 


c2; { h h + sourceForm Height } 


c3; 


c3; 


cl; 

c2; 

c3; { sx + w } 


cl; 

c2j { w w - (sx + w )} 


cl, at [checkSourceFormWldth, 10, checkSmallInt-return]; 


BRANCH [sFormWIdthGE, sFormWIdthLT], c2; 

sFormWIdthGE: 

sourcelndex uW, GOTO [sFormNIll], c3; 

sFormWIdthLT: 

uW sourcelndex, GOTO [sFormNIll], c3; 


sFormNilO: 

sourcelndex uW, 


c3: 


{ - check the h and w. If h <= 0 OR w <=0 then return immediately - } 

sFormNIll: 

sourceAddrLow uH, cl; 

sourcelndex sourcelndex - 1, NegBr, c2; { check the width =*< 0 ??} 

sourceAddrLow sourceAddrLow - 1, NegBr, BRANCH [wldthGTO, wldthLEO], c3; { check the height =< 0 ???} 


wldthGTO: 

uHMl sourceAddrLow, BRANCH [heightGTO, helghtLEO], 


cl; 


heightGTO: 

LI getMasks, GOTO [computeMask], 


c2; 
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wldthLEO: 

CANCELBR [$, OF], cl; 

helghtLEO: 

L2 noTransfer, GOTO [noTransfer3], c2; { restore the Smalltalk state and execute next byte 

code } 


{ 


compute the several kind of Mask 


computeMask: 

Q 1, CALL [getSeveralMasks], 


■} 

c3; { Q for the intlal value of nWords } 


{ 

At return point : 

maskl, mask2, skewMask, skew and startBIts have already been calculated, and been stored In uMaskl, uMask2, SkewMask, uSkew, and 
uStartBIts respectively 

} 


getSeveralMasksRet: 

otLow uW, cl; 

getSeveralMasksRetl: 

destAddrLow uStartBIts, c2; 

otLow otLow - destAddrLow, NegBr, c3; {w < startBIts T? : w - startBIts } 

sourcelndex uMask2, BRANCH [wldthNotTooSmall, wldthTooSmall], cl; 


wldthTooSmall: 

sourcelndex sourcelndex and uMaskl, 
uMaskl sourcelndex, 

uMa$k2 sourcelndex xor sourcelndex, 
uNWords Q, 

OtLow Q, GOTO [checkOverlap], 


c2; { maskl maskl bltAnd: mask2 } 
c3; 

cl; { mask2 0 } 

c2; { uNWords 0{1}, because of 0 origin } 
c3; 


wldthNotTooSmall: 

otLow otLow - 1, NegBr, c2; 

otLow otLow and -OF, BRANCH [noNegatlve, yesNegatlve], c3; 


yesNegatlve: 

otLow otLow xor -otLow, GOTO [noNegatlvel], 


cl; { make otLow -1} 


noNegatlve: 

otLow otLow LRotl2, 
noNegatlvel: 

otLow otLow + 2, 

uNWords otLow, GOTO [checkOverlap], 


cl; { (w-startBIts-l//16} 

c2; { (w - startBIts - 1//10 + 2 } 
c3; { save nWords } 


CheckOverlap 


checkdverlap: 

Noop, 

otLow otLow - Q, 
uNWordsMl otLow, 

checkOverlapl: 

uStackF otLow, 
uVDIr Q. 

uHDIr Q, L2 getDestBIts, 

che<:kOverlap2: 

templLow uSourceForm, 
destAddrLow uDY, 
sourceAddrLow uSY, 

check0verlap3: 

[] templLow xor uDestForm, ZeroBr, 

[] destAddrLow - sourceAddrLow, NegBr, 
BRANCH [sameOopNo, sameOopYes], 


sameOopYes: 

[] sourceAddrLow xor destAddrLow, ZeroBr, BRANCH 


dyGIi: 

sourcelndex uHMl, BRANCH [dyGT, dyEQ], 


{sourceForm==destForm and dy>$y} 
dyGT: 

uVDIr temp2Low xor ~temp2Low, 
destAddrLow destAddrLow + sourcelndex. 


“} 

cl: 

c2; {decrement} 
c3; 


cl; 

c2; { default v-dlrectlon * 1} 
c3; { default h-dlrectlon = 1 } 


cl; 

c2; 

c3; 


cl; { sourceForm =* destFrom ??} 


c2; { dy >=> sy ?? } 


[dyGE, dyLT], c3; { dy = sy ??} 


cl; { sourcelndex h - 1} 


c2; { vDIr -1 } 
c3; { dy dy + h - 1} 


BBT.me 


g-Feb-88 18:16:58 PST 


7 












dyGTl: 

soureaAddrLow sourceAddrLow + sourcelndex, 

uOY destAddrLow, 

uSY sourceAddrLow, GOTO [dyLT], 


£sourceForm==destForm and dy=sy} 

dyEQ: 

sourcaAddrLow uSX, 
destAddrLow uDX, 

dyEQl: 

[] sourceAddrLow - destAddrLow, NegBr, 
uHDIr temp2Low xor -tempZLow, BRANCH [dxLE, 


{ sourceForm==destForm and dy=sy and dx>sx } 
dxGT; 

sourcelndex uW, 

sourcelndex sourcelndex - 1, 
sourceAddrLow sourceAddrLow + sourcelndex, 
destAddrLow destAddrLow + sourcelndex, 

dxGTl: 

otLow uSkewMask, 
uSkewMask -otLow, 
templLow uMaskl, 

dxGT2: 

temp2Low uMask2, 
uMaskl temp2Low, 
uMask2 templLow, 

dxGT3: 

uDX destAddrLow, 
uSX sourceAddrLow, 

samoOopNo: 

CANCELBR [dyLT, 1], 


dxLE: 

uHDIr Q, GOTO [dyLT]. 


cl; { sy sy + h - 1} 
c2; 
c3; 


c2; 
c3; 


cl; { dx > sx ??} 

dxGT], c2; { hDlr -1 : So far default} 


c3; 
cl; 

c2; £ sx sx + w - 1} 
c3; £ dx dx + w - 1} 


cl; 

c2; { skewMask bltlnvert } 
c3; 


cl; 
c2; 

c3; {exchange maskl and mask2} 


cl; 

e2; { save sx } 


c3; 


c3; 


dyLT: 

CANCELBR [$, 1], 


cl; 


{ 


calculate Offsets 


} 


calculateOffset: 

otLow uDestBItMap, CALL [getSTFormMapBasel], 

{ at return 

tomplHIgh, templLow : map base 

tomp2Low : word no. par 1 horizontal line ( destRaster ) 
otLow : Oop for bitmap 

} 

calculateOffsetl: 

destAddrLow templLow, L2 getDestMul , 

Q uDY, CALL [bbtMultlply], 

{ destAddrLow Points the actual destination Address. Now, we calculate 
destAddrLow destAddrLow Q, 
sourcelndex uDX, 

getDestAddrl: 

sourcelndex sourcelndex and -OF, 
sourcelndex sourcelndex LRotl2, 
destAddrLow destAddrLow + sourcelndex, 

gett)estAddr2: 

templLow templHIgh, 
destAddrHIgh templLow LRotO, 

Xbus uVDIr, XHDIsp, 

checkDIr: 

Xbus uHDIr, XHDIsp, BRANCH [vPl, vMl, 2], 


v P1 °, 

sourcelndex uNWords, BRANCH [vPlhPl, vPlhMl, 2], 


c2, at [getDestBlts, 10, getSTFormMapBase-return]; 
c3; { destlndex dy*destRaster : Q Q+temp2Low } 

the destDelta } 

c2, at [getDestMul, 10. bbtMultlply-return]; 
c3; 


cl; 
c2; 

c3; £ destlndex destRaster+dy +(dx//18)} 


cl; 

c2;{ save the destination High address } 
c3; 


cl; 


c2;£save the destination Map to check} 


vPlhPl: 

temp2Low temp2Low-sourceIndex, L2 getSourceBIts, 
GOTO [saveDestDeltal], 


c3; { destDelta destRaster +1 - nWords * 1 } 


vPlhMl: 
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temp2Low temp2Low + sourcelndax, L2 getSourcaBlts. 

GOTO [savaDestDeltal], c3; { destDealta destRaster*! - nWords*(-l)} 


vMl: 

sourcelndax uNWords, BRANCH [vMlhPl, vMlhMl, 2], 


c2; 


vMlhPl.: 

tamp2Low - temp2Low, c3; 

temp2Low temp2Low - sourcelndax {- 1}, GOTO [saveDastDelta]. cl; { destDelta destRaster*(-1) - nWords*!} 


vMlhMl: 

temp2Low sourcelndax - temp2Low, GOTO [saveDastDeltal], 


c3; {destDelta destRaster*(-1) - nWords*(-l)} 


savoDestDeltal: 

Noop, cl; 

saveDastDelta; 

uDestDelta temp2Low, 12 getSourcaBlts, c2; 

{ Next we check the sourceForm } 

getSFormAddr: 

templLow uBooleans, XDIsp, c3; 

otLow uSourceForin, BRANCH [getSTFormMapBase, saveBool eans, OD], cl; { dafault preload = False, so uBooleans, 15 =< 0} 


{ at return 

templHIgh, Low : source MapBase 

temp2Low ; Word no of 1 horizontal line ( sourceRastar ) 
otLow : Oop for BltMap 

} 

getSFormAddrl; 

sourceAddrLow templLow, L2 getSourceMul, 

Q uSY , CALL [bbtMultlply], 

{ sourceAddrLow points the actual source address } 
sourceAddrLow sourceAddrLow + Q, 

Q templHIgh, 

getSourceAddr: 

sourceAddrHIgh Q LRotO, 

sourcelndax uSX, 

templLow sourcelndax and ~0F, 

templLow templLow LRotl2, 

Q skew, ZeroBr, 

sourceAddrLow sourceAddrLow ■*• templLow, 

BRANCH [skewNonZero3, skewZero3], 


c2, at [getSourcaBlts. 10 , getSTFormMapBase-return]; 
c3; { sourcelndax sy*sourceRaster : Q Q*temp2Low } 


c2, at [getSourceMul, 10, bbtMultlply-return]; 
c3; 


cl: { save high source address } 

c2; 

c3; 

cl; 
c2; 

c3;{ sourcelndex sourceRaster*sy + (sx//18)} 


skewNonZero3: 

sourcelndex sourcelndex and OF, 
skewNonZero4: 

[] sourcelndex - Q, NegBr, 

templLow uBooleans, BRANCH [skawLEl, skewGTl], 


cl; { sx bltAnd: 15 } 

c2; { skew <=• (sx bltAnd: 15)} 
c3; 


skewLEl: 


templLow templLow or 1, GOTO [checkhDIr], 


cl; { preload = True } 


skewGTl: 


GOTO [checkhDIr], 


cl; { preload ■ False } 


skewZero3: 

templLow uBooleans, GOTO [checkhDIr], 


cl; 


{ Now, temp2Low still has the sourceRaster } 
checkhDIr: 

Q uHDIr, XHDIsp, 

[] templLow, YDisp. BRANCH [hPl, hMl, 2], 


c2; 
c3; 


hPl: 


sourcelndex uNWords, 

BRANCH [hPIPreFalse, hPIPreTrue, OE], 


cl; 


hPIPreFalse: 

sourcelndex sourcelndex, GOTO [checkVDIrl], 


c2; { nWords + 0*1 : preload 3 False, hDIr - 1 } 


hPIPreTrue: 

sourcelndex sourcelndex + 1, GOTO [checkVDIrl], 


c2; { nWords +■ 1*1 ; preload = True, hDIr - 1 } 


hMl: 

sourcelndex uNWords, 

BRANCH [hMIPreFalse, hMIPreTrue, OE], 


cl; 


BBT.me 


g-Feb-86 16:16:58 PST 


9 




- Now, hDIr < 0 IfTrue: [preload preload *■ false] 

- so. preloadFalse actually means preload = True. preloadTrue vice versa. 

---- } 


hMIPreFalse: 

sourcelndex 0 - sourcelndex - 1, 
templLow templLow or 1 , GOTO [checkV01r2], 


c2; {nWords + 1*(-1) : preload = False, hDIr 
c3; { make preload ■ True } 


"I } 


hMIPreTrua: 

sourcelndex 0 - sourcelndex , 

templLow templLow and OE, GOTO [checkVDir2], 


c2; (nWords + 0*(-l) : preload * Trued. hOir a -1 } 
c3; { make preload s False } 


checkVDirl: 

Noop, 


c3; 


checkVDir2: 

Xbus uVDir, XHDisp, 

Q - temp2Low, BRANCH [vDirPl. vDirMl. 2], 


cl; 

c2; { Q - sourceRaster } 


vDirPl: 

{ sourceRaster+l - (nWords +(preload ifTrue: [1] ifFalse: [0])+hDir)} 

temp2Low temp2Low - sourcelndex, c3; 

uSourceOelta temp2Low. GOTO [saveBooleans], cl; 


vDirMl: 

£sourceRaster*(-l) - (nWords +(preload ifTrue: [1] IfFalse: [0])*hD1r)} 

Q Q - sourcelndex, c3; 

uSourceDelta Q, cl; 

saveBooleans: 

uBooleans templLow, YDisp, LI getHalftoneBits. c2; 

{ now Get the halftone Form address } 

otLow uHalftoneForm, BRANCH [{CALL} otMap2BankO, hFormNil21. OB], c3; 


getHalftone: 

MAR templLow [templHigh, templLow + formMapBaselndex], cl, at [getHalftonaBits, 10. otMap2BankO-return]; 

getHalftoneAddr: 

BRANCH [noPCGetHalftone, yesPCGetHalftone, 1], c2; 


yesPCGetHalftone: 

templLow templLow *■ OFF + 1, c3; 

MAR [templHigh, templLow + 0], GOTO [getHalftoneAddr], cl; 

noPCGetHalftone: 

otLow MD, LI getHalftoneBitsl, c3; 

[] otLow and nonPointerMask, ZeroBr, cl; 

BRANCH [$, hBitMapNoOop], c2; 

CALL [otMap2BankO], c3; 

hFormN1121: 

GOTO [startVLoop], cl; 


hFormN112: 

templLow templLow + firstFieldOfObject, 


cl, at [getHalftoneBitsl. 10. otMap2BankO-return]; 


t .-.. 

-- Register Usage: 

RO 


--> 

— 

RH1, 

Rl 


— 

RH2, 

R2 


-- 

RH3 


—> 

— 

R3 


— > 

-- 

RH5, 

R5 

—> 


(sourcelndex) 

--> Address of destinationBits 


(destAddrHigh, sourceAddrLow) 


--> Address of sourceBits (sourceAddrHigh, sourceAddrLow) 

**** High Address of OT **♦*«•* 

Destinationlndex (destlndex) 

Address of halftoneBits (HalftoneAddrHIgh, HalftoneAddrLow) 


c 

- Start of Vortical Loop 


} 


3 

startVLoop; 

Xbus uBooleans, XDisp, L2 bbtCheckMInt, c2; 

startVLoopl: 

LI 0, Q uHDIr, DISP4 [vLoop], c3; 


{-skewlO, HForm=SForm»~nil , Preload 3 FALSE-•—} 

startVLoopOO: 

sourcelndex uVDir, CALL [getHalftoneWord], cl, at [00, 10, vLoop]; 
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s tartVLoopOOZ: 

temp3Low uNWordsMl, L2 skewWord, 
StartVLoopOOl: 

otLow uMaskl, 

sourcelndex sourcelndex xor sourcelndex, 
Noop, 

CALL [calSkewWord], 

MAR [destAddrHigh, destAddrLow + 0], 
temp2Low temp2Low and uHalftoneWord, 
sourcalndex MO, 

L2 bbtCheckMInt, 

Xbus uComblnatlonRule, XDIsp, 

Q uHDIr, DISP4 [combQD], 


c2, at [00, 10, getHalftoneWord-return]; 

c3; 

cl; 
c2; 
c3: 

cl, at [skewWord, 10, calSkewWord-return]; 

c2; 

c3; 

cl; 
c2; 
c3; 


{-skewOO, HForm=~nn , SForm-~nil, Preload=TRUE-} 

startVLoopOl: 

sourcalndex uVDIr, CALL [gatHalftoneWord], 

startVLoopOll; 

tamp3Low uNWordsMl, 
otLow uMaskl, 


cl, at [01, 10, vLoop]; 

c2, at [01, 10, getHalftoneWord-return]; 
c3; 


MAR [sourceAddrHIgh, sourceAddrLow + 0], cl; 
sourceAddrLow sourceAddrLow + Q, L2 skewWord, c2; 
sourcalndex MD, CALL [calSkewWord], c3; 


{-skewOO, HForm=~n11, SForm=n11, Preload = FALSE **-} 

$tartVLoop02: 

sourcalndex uVOIr, CALL [getHalftoneWord], cl, at [02, 10, vLoop]; 

temp3Low uNWordsMl, GOTO [startVLoopOAl], c2, at [02, 10, getHalftoneWord-return]; 


{-skewOO, HForm=~n11, SForm^nl 1 , Praload = TRUE— - INVALID -} 

startVLoop03; 

GOTO [Iteration], cl, at [03, 10, vLoop]; 


{-skewOO, HForm=nil, SForm=-n11, Preload=FALSE--} 

startVLoop04: 

tempZLow uHalftoneWord temp2Low xor ~temp2Low, cl, at [04, 10, vLoop]; 

temp3Low uNWordsMl, L2 skewWord, GOTO [startVLoopOOl], c2; 


{-skewOO, HForm-nll, SForm a ~n11 , Preload=TRUE-} 

st.artVLoop05: 

uHalftoneWord temp2Low xor ~temp2Low, GOTO [startVLoopOll], cl, at [05, 10, vLoop]; 


{-skewOO, HForm=n11, SForm= nil, Preload°FALSE **--} 

startVLoopOS: 

temp2Low uHalftoneWord temp2Low xor ~temp2Low, 

GOTO [startVLoopOEl], cl, at [06, 10, vLoop]; 


{-skewOO, HForm=n11, SForm=n11, Preload"TRUE- INVALID -} 

startVLoop07: 

GOTO [Iteration], cl, at [07, 10, vLoop]; 


{-skew-0, HForm=~n11, SForm a ~n11, Preload = FALSE-} 

startVLoop08: 

sourcalndex uVDIr, CALL [getHalftoneWord], 

otLow uMaskl, 
stai'tVLoop081: 

tempSLow uNWordsMl, 


cl, at [08, 10, vLoop]; 

c2, at [08, 10, getHalftoneWord-return]; 

c3; 


MAR [destAddrHigh, destAddrLow + 0], cl; 
Xbus uComblnatlonRule, XDIsp, c2; 
sourcelndex MD, L3 0, DISP4 [combOC], c3; 


{--skew-0, HForm=~n 11, SForm=>~n11 , Preload-TRUE— - INVALID ---} 

stai'tVLoop09: 

GOTO [Iteration], cl, at [09, 10, vLoop]; 


{-skew=0, HForm=~n 11 , SForm-nll , Preload = FALSE——— -} 

startVLoopOA: 

sourcelndex uVDIr, CALL [getHalftoneWord], 

temp3Low uNWordsMl, 
startVLoopOAl: 

otLow uMaskl, 


cl, at [OA, 10, vLoop]; 

c2, at [OA, 10, getHalftoneWord-return]; 

c3; 


MAR [destAddrHigh, destAddrLow + 0], cl; 
Xbus uComblnatlonRule. XDIsp, c2; 
sourcelndex MD, L3 0, DISP4 [combOE], c3; 


{-skew-0, HForm-~n11, SForm-nll, Preload a TRUE 


INVALID .} 
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startVLoopOB: 

GOTO [iteration], 


cl. at [OB, 10, vLoop]; 


{-skaw-0, HForm-nll, SForm=~n11 , Preload-FALSE-} 

startVLoopOC: 

temp2Low uHalftoneWard temp2Low xor ~temp2Low, cl, at [OC, 10, vLoop]; 

otLow uMaskl, GOTO [startVLoopOSl], c2; 


{-skew-0, HForm=n11, SForm=~n11, Pre1oad=-TRUE- INVALID .-.} 

startVLoopOO: 

GOTO [Iteration], cl, at [OD, 10, vLoop]; 


{-skew=0, HForm»nn, SForm=ni1, Preload-FALSE--} 

startVLoopOE; 

temp2Low uHalftoneWord temp2Low xor ~temp2Low, cl, at [OE, 10, vLoop]; 

startVLoopOEl; 

temp3Low uNWordsMl, GOTO [startVLoopOAl], c2; 


{-skew=0, HForm-nll. SForm=nil, Preload-TRUE ------- INVALID .-} 

startVLoopOF: 

Noop, Cl, at [OF, 10, vLoop]; 

iteration: 

Noop, c2; 

GOTO [startVLoopOF], c3; 


{ 


Start of Horizontal Loop 


- — — - 

sourcaflddrHIgh, sourcaflddrLow 


(RH2, R2) 

-- 

— 

destAddrHigh, destAddrLow 


(RH1, Rl) 

-- 

— 

templHIgh, templLow(Halftone 

Form) 

(RH4, R4) 

-- 

— 

temp2Low : prevWord 

(R5) 


— 

— 

sourcelndex : skewWord 

(RO) 


-- 

— 

skew : 

(RHO) 


-- 


temp3Low : loop conter(word) 

(R8) 


-- 

— 

otLow : maskl(mergeMask) 

(R3) 




c-.. 

- no Mesa Interrupt - 

..} 


reentryBitblt: 

destAddrLow destAddrLow + temp3Low, LIDIsp, 

BRANCH [sFormNonNUMIntCheck, sFormNUMIntCheck, OD], 


c2, at [bbtCheckMInt, 10, noMesalnterrupt-return]; 


sFormNUMIntCheck: 

Q uHDIr, DISP4 [vLoop], 


c3; { update destAddr } 


sFormNonNIIMIntCheck: 

Q uSourceDelta, CANCELBR [$, OF], c3; 

sourceAddrLow sourceAddrLow + Q, cl; 

LIDIsp, GOTO [sFormNUMIntCheck], c2; 


- Mesa Interrupt - 

~.} 

{save the bitBIt parameters into the mesa stack, and restore Smalltalk ip, stackp, home 
teinp2Low=0F , this value Is store in checkMesalnterrupt} 


mesnlntlnBItblt: 

uDestAddrLow destAddrLow, 

c3, 

at [bbtCheckMInt, 10, mesalnterrupt-return]; 

mesalntlnBitbltl: 

destAddrLow destAddrHigh, stackP temp2Low, 

cl; 


sourcelndex uComblnatlonRule, 

c2; 


sourcelndex sourcelndex LRot8, 

c3; 


destAddrLow destAddrLow or sourcelndex. 

cl; 


uDestAddrHIgh destAddrLow, 

c2; 

{save hlghaddr of dost and combination Rule } 

sourcelndex uDY, 

c3; 


mesaIntInBitblt2: 

sourcelndex sourcelndex and temp2Low, 

cl; 

{08-0B: dy's offset} 

sourcelndex sourcelndex LRot4, 

c2; 


Q skew, 

c3; 


mosiiIntInB1tblt3: 

sourcelndex sourcelndex or Q, 

cl; 

{00-03: dy's offset, 04-07: skew} 

sourcelndex sourcelndex LRot8, 

c2; 


temp2Low uBooleans, XDisp, 

c3; 


mesalntlnBitblt4j 

temp2Low temp2Low and OF, DISP4 [shForm, 9], 

cl; 
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(halftone = n11, source~ a n11} 

uSourceAddrLow sourceAddrLow, 
sourceAddrLow sourceAddrHIgh, 

sourceAddrLow sourceAddrLow LRot8, 
uSaveHlghAddr sourceAddrLow, 
saveDelta: 

templLow uSourceDelta, 

templLow templLow and OFF, GOTO [bothNII], 


{ha1ftone«»n11, source a nll} 

uHalftoneAddrLow templLow, 
templLow templHIgh, 

uSaveHlghAddr templLow, GOTO [bothNII], 


(halftone~ a nll, source~ a nil} 

uHalftoneAddrLow templLow, 

Q templHIgh, 

uSourceAddrLow sourceAddrLow, 
sourceAddrLow sourceAddrHIgh, 
sourceAddrLow sourceAddrLow LRot8, 

Q Q or sourceAddrLow, 
uSaveHlghAddr Q, GOTO [saveDelta]. 


(halftone a n11, source=nil} 
bothNII: 

temp3Low uDestDelta, 
temp3Low temp3Low and OFF, 

templLow templLow LRot8, 
templLow templLow or temp3Low, 
uDestDelta templLow, 

saveOlrectlon: 

Xbus uHDIr, XHDIsp, 

Xbus uVDlr, XHDIsp, BRANCH [hDIrPlusSave, hDIrMInusSave, 


c2, at [OD, 10, shForm]; { sourceAddrLow } 
c3; 

cl; 

c2; (00-07: sourceAddrHIgh } 

c3; 

cl; 


c2, at [OB, 10, shForm]; 
c3; 

cl; (08-0F: halftoneAddrHIgh} 


c2, at [9, 10, shForm]; (save halftoneAddrLw } 
c3; 

cl; (sacve sourceAddrLow} 

c2; 

c3: 

cl; (00-07:sourceAddrHIgh, 08-OF:halftoneAddrHIgh} 
c2; 


c2, at [OF, 10, shForm]; 
c3; 

cl; 
c2; 

c3; (00-07:sourceDelta, 08-0F: destDelta} 


cl; 

2], c2; 


hDIrPlusSave: 

BRANCH [vDirPlusSave, vOirMinusSave, 2], 


c3; 


vDIrMlnusSave: 

temp2Low temp2Low or 40, GOTO [saveMisc], 


cl; (vDIr a -1} 


hDIrMlnusSave: 

temp2Low temp2Low or 20, BRANCH [vDirPlusSave, vDirMlnusSave, 2], 


c3; (hDIr - -1} 


vDIrPlusSave: 

Noop, cl; 

saveMisc: 

(00-03: dy's offset, 04-07:skew, 09:vD1r a -l, 0A:hD1r a -l, OC-QF: booleans} 

sourcelndex sourcelndex or temp2Low, L2 bltbltNotFInlshed, c2; 

uMIsc sourcelndex, CALL [restoreStatus], c3; 


LODIsp, 


c3, at [bltbltNotFInlshed. 10, restoreStatus-return]; 


XC2npcD1sp, DISP2 [IpAjustlnBBT] , 


cl; 


CANCELBR [IpAjustedlnBBT, OF], 

IpAjustedlnBBT: 

templLow 0, GOTO [saveSmalltalkStateBankO], 


c2, at [0, 4, IpAjustlnBBT]; 
c3; 


templLow 0, BRANCH [pcl60ne, pclBZero, OE], 


c2, at [1, 4, IpAjustlnBBT]; 


pclflOne: 

Cln pcl6 , GOTO [saveSmal1talkStateBankO], 


c3; 


pclflZero: 

IpLow IpLow - 1, Cln pcl0, GOTO [saveSmalltalkStateBankO], 
IpLow IpLow - 1. CANCELBR [IpAjustedlnBBT, OF], 
templLow 0, BRANCH [pcl0Onel, pclSZerol, OE], 


c3; 

c2, at [2, 4, IpAjustlnBBT]; 
c2, at [3, 4, IpAjustlnBBT]; 


pclOOnel: 

IpLow IpLow - 1, Cln pcl6, GOTO [saveSmal1talkStateBankO], c3; 
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pclfiZerol: 

ipLow IpLow - 2, Cln pclQ, GOTO [saveSmalltalkStateBankO], c3; 


allFInlshed: 

temp2H1gh uRumRecordHIgh, 
al 11 : 1 nl shedl: 

temp2Low uRumRecordLow, 

allF1n1shed3: 

temp2Low temp2Low + cursorBItmapOopOffset, 

L2 bltbltF1nlshed, 

stack? 1, CALL [restoreStatus], 

otLow uDestBItMap, 

MAR [temp2H1gh, temp2Low + 0], 

LI getCursorMep, 

Q MD, 

[] Q xor otLow, ZeroBr, 

BRANCH [noCurrentCursor, yesCurrentCursor], 


yesCucrentCursop: 

temp3High CSBforCursorHIgh, CALL [otMap2BankO] , 
yesCurrentCursorl: 

templLow templLow + sizeFialdOffset. 
temp3Low CSBforCursorLow, 

Q 10, 

MAR [templHIgh, templLow + 0], LI cursorWIdthl, 

CALL [checkSmallInt], 

[] temp2Low {size} - Q, NegBr, 

167? } 

templLow templLow +• 1, BRANCH [sIzeGElOx, sIzeLTlOx], 


sIzeGElOx: 

temp2Low 11, GOTO [restoraCursorPattern], 


slzeLTlOx: 

temp2Low temp2Low + i, 

restoraCursorPattern: 

temp2Low temp2Low - 1, ZeroBr, 

BRANCH [contlnueRestoreCursor, endRestoreCursor], 


cont1nueRestoreCursor: 

Noop, 

MAR [temp3Hlgh, temp3Low + 0], 
temp3Low temp3Low + 1, 

Q MD, 

MAR [templHIgh, templLow +■ 0], 

MDR Q. 

templLow templLow +■ 1, GOTO [restoreCursorPattern], 


endRestoreCursor: 

GOTO [nextBytaCodelnBankO], 


noCurrentCursor: 

GOTO [nextBytaCodelnBankO], 


c2; 
c3; 


cl: 
c2; 

c3,* { restore the Mesa stack Pointer } 

c3, at [bltbltFInlshed, 10, restoreStatus-return]; 

cl; 

c2; 

c3; { get current cursor map } 

cl; 
c2; 


c3; 


cl, at [getCursorMap, 10. otMap2BankO-return]; 

c2; 

c3; 

cl; 
c2; 

cl, at [cursorWIdthl, 10, checkSmallInt-return]; { size < 
c2; { point the first (??) field of object } 


c3: { loop ocunt 3 18'd} 


c3; { loop count = size of currentcursorbltmap} 


cl; 
c2; 


c3; 

cl; 
c2; 

c3; { get current pattern } 
cl; 

c2; { save current pattern to ...} 

c3; 


c3; 


c3; 

£ the receiver returns Itself, so there Is no need for Smalltalk stack clean up} 


destWIdthLessO: 

GOTO [noTransferl], 


c3; 


destHelghtLessO: 

L2 noTransfer, GOTO [noTransfer3], 


c2; 


clIpWldthLessO: 

GOTO [noTransfer2], 


cl; 


clIpHelghtLessO: 

L2 noTransfer, GOTO [noTransfer3], c2; 


wldthLTO: 

GOTO [noTransferl], c3; 
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helghtLTQ: 

GOTO [noTransfer2], cl; 

noTransferl: 

L2 noTransfer, cl; 

noT ransfer2: 

L2 noTransfer, C 2; 

noTransfer3; 

CALL [restoreStatus], c3; 


GOTO [nextByteCodelnBankO], 


c3, at [noTransfer, 10, rastoreStatus-return]; 


hBltMapNoOop: 

L2 prlmFall, GOTO [prlmitiveFallBItBltl], 

c3; 

halftoneFormlnvalId: 

L2 prlmFall, GOTO [prlmltlveFallBItBlt3], 

c2; 

destFormlnvalId: 

L2 prlmFall, GOTO [prlmitiveFallBItBlt3], 

c2; 

sourceFormlnvalId: 

L2 prlmFall, GOTO [pr1m1t1veFa11B1tBlt3], 

c2; 

prlmitiveFallBItBltl: 

Noop, 

cl; 

prlmltlveFallB1tBlt2: 

Noop, 

c2; 

prlmltlveFallB1tBlt3: 

stackP 1, CALL [restoreStatus], 

c3; 


templLow 2, GOTO [saveSmalltalkStateBankO], c3, at [prlmFall, 10, restoreStatus-raturn] ; 


destlnatlonNonOop: 

CANCELBR [$, 1], cl; 

sourcaNonOop: 

CANCELBR [$. 1], c 2; 

halftoneNonOop: 

L2 prlmFall, CANCELBR [prlmltlvaFal181tBltl, 1], c3; 


comtilnatlonRuleTooBIg: 

L2 prlmFall, GOTO [prlmitiveFallBItBltl], 


c3; 


{ Edit history: 


22-3an-86 15:55:22 
20-3an-88 10:31:02 
when Mint occur. 
27-Dac-85 14:35:33 
7-MOV-85 18:48:48 
10-Oct-85 18:59:32 
16-Oct-85 16:34:22 
30-Sep-86 15:56:37 
27-Sep-85 16:34:57 
27-Sep-85 14:00:35 
27-S0P-85 13:59:42 
13-Sep-86 13:28:45 
prlmltlveCopyBIts and 
20-Jun-85 9:53:33 


Tokunaga 

Tokunaga 

Tokunaga 
Tokunaga 
Sakaklbara 
Sakaklbara 
Sakaklbara 
Sakaklbara 
Sakaklbara 
Matsumoto 
Tokunaga 
remove calling 
Tokunaga 


for stretched 

exchange uDestBItMap and uComblnatlonRule. and modify the save and restore ConblnatlonRule value 

refine the routine concerning with saving and restoring copyBIts status when mesa Int occur 
modify the routine for getting the actual address of BltMap Object (calculateOffset) 
change usource 

change several points (by Tokunaga) 

Fix templLow value at noPCarryC 
Added comb1natlonRule*16 check 
Bug fix PrlmltlveFall 
Add CANCELBR Mask 

Add the adjustment for Smalltalk Instruction pointer when Mesa Int occur during 
updateCursor. 

remove checkSmalllnt to bbtsubs.mc } 
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{ BElTSubs.mc 

Subroutines for BitBlt primitive for Rum. the Dandelion Smalltalk-80 mlcrocoded virtual machine, 
by T Tokunanga, M Sakaklbara, J Trow 
9-Feb-86 17:43:46 

Copyright 1985. 1986 by Xerox Corporation. All rights reserved. } 


{checkSmalllnt: *************** stretched **'* + *'***** + '* + ’** + 
subroutine for checking small Integer & convert to normal Integer 
At entry : c3 
At Return : cl 
Link register : LI 
to be checked : temp2Low 
result : temp2Low 

Note: templLow Is Incremented. 


checkSmallint: 


temp2Low 

MD. XHDisp. 


c3; 

[] temp2Low and nonPoInterMask, 

ZeroBr, 


BRANCH [posSmal1 Integer, 

negSmal1 Integer, 2], 

cl; 

posSmallInteger: 

temp2Low 

RRotl temp2Low, BRANCH 

[oops, notOops], 

c2; 

negSmal1 Integer: 

temp2Low 

RRotl (temp2Low or 3), 

BRANCH [oops, notOops], 

c2; 

notOops: 

temp2Low 

RRotl temp2Low, 


c3; 

Noop, 

templLow 

templLow + 1, LIDIsp, 


cl; 
c2; 

RET [checkSmal1Int-return], 


c3; 


oops: 

L2 prlmFall, GOTO [prlmltlveFallBItBltl], 


c3; 


{checkSmalllnt2: t************** stretched *♦+**♦#*•+*♦♦♦** 
subroutine for checking smalllnteger & convert to normal Integer 
At entry : c3 
At Return : cl 
Link register : LI 
to be checked : tamp2Low 
result : temp2Low 

Note: templLow Is incremented. 


checkSmal1Int2: 

temp2Low MD, XHDisp, c3: 

checkSmal!Int2cl: 

[] temp2Low and nonPoInterMask, ZeroBr, 

BRANCH [posSmallInteger2, negSmaninteger2, 2], cl; 

posSmal1Integer2: 

temp2Low RRotl temp2Low, BRANCH [oops2, not0ops2], c2; 

negSmal1Integer2: 

temp2Low RRotl (tamp2Low or 3), BRANCH [oops2. notOops2], c2; 

notOops2: 

temp2Low RRotl temp2Low, c3; 

Noop, cl; 

templLow templLow + 1, LIDIsp, c2; 

RET [checkSmal1Int2-return]. c3; 


oop«2: 

L2 prlmFall. GOTO [prlmltlveFallBItBltl], 


c3; 
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{ 

- ex: maskl RightMasks at: startBIts + 1 


Entry point ; c2. c3 Exit point : c3 

the argument Is stored In temp3Low , If It Isn't between 0 and 10’X then prlmltlveFall. 
Return link: L3 
Result : temp2Low } 
makeRIghtMasks: 

Noop, c2; 

makeR1ghtMasks3: 

temp2Low temp2Low xor temp2Low, c3; 


{ argument is between 0 and 10*X } 
argOKInBBT: 

temp3Low temp3Low - 1, NegBr, cl; {decrement the shift counter } 

L3D1sp, BRANCH [shlftLoop, shlftEnd], c2; 


shlftLoop: 

temp2Low temp2Low LShlftl, SE 1, CANCELBR [argOKInBBT, OF], c3; 


shlftEnd: 

RET [makeRlghtMasks-return], 


c3; 


{ This routine Is for checking Mesalnterrupt , ST80 B1t81t use this routine. } 


return link : L2 

No Interrupt Exit point: return cycle a cl, pending Xdlpatch by uBooleans 
temp3Low : DestDelta 
Interrupt Exit point ; c2} 


c 

PC : MesaStatePC, 

pcl6 : MesaStatePClB (pcl6 = Bit.15) 
rhPC : MesaStateRhPC 
IBptr: MesaStatelBPtr 
IB : MesaStatelB 

uPPCross: 0 —> no Cross 

~Q —> Cross 

UvChigh : high Address bot od code segment 
UvPCpage: virtual page No of current mesa code 

} 


{ register definition } 

RegDef [MesaStatePC, U, 50]; 

RegDef [MesaStatelBPtr, U, 53]; 

RegDef [MesaStatelB, U, 54]; 

RegDef [MesaStateRhPC, U. 51]; 

checkMesaXnterrupt: 

temp2Low OF, MesalntBr, cl;{us1ng If mesa Interrupt occur as a stack value} 

checkuWP: 

temp3Low uWakeupPendlng, ZeroBr, 

BRANCH [bltBltNoInterrupt, maybelnterrupt], c2; 


bltBltNoInterrupt: 

temp3Low uDestDelta, L2D1sp, CANCELBR [nolnterrupt, 1], c3; 


maybelnterrupt: 

temp3Low uDestDelta, L2D1sp, BRANCH [bltBltlnterrupt, nolnterrupt], c3; 


nolnterrupt: 

Xbus uBooleans, XDIsp, RET [noMesalnterrupt-return], 


cl; 


bltBltlnterrupt: 

temp3Low MesaStatePC, CANCELBR [$, OF], cl; 

temp3Low temp3Low -1, c2; 

temp3H1gh MesaStateRhPC, c3; 

bltBltNoCross: 

MAR [temp3H1gh, temp3Low + 0], Xbus MesaStatelBPtr, XDIsp, cl; 

MesaStatePC temp3Low, DISP4 [bltBltRestorelB, OC], c2; 


{Empty} Noop, GOTO [clearCrossIndlcator], 

{Byte} temp3Low MD, GOTO [clearCrossIndlcator], 

{Full} GOTO [bltBltNoCross]* 

{Word} tempSLow MD, GOTO [clearCrossIndlcator], 

{there Is no check for pcl6, bacause 1 or 2 bytes are stored into IB 
InltAndMesaStateSaveAndRestore.me } 


c3, at [OC, 10, bltBltRestorelB]; 
c3, at [OD, 10, bltBltRestorelB]; 

c3, at [0£, 10. bltBltRestorelB]; {forever iteration} 
c3, at {OF, 10, bltBltRestorelB]; 

MesaStatelB coresspondlng to the pol0 respectively In 
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clearCrossIndlcator: 

uPCCross destAddrLow xor destAddrLow, L2D1sp, 
MesaStatelB temp3Low, RET [mesalnterrupt-return], 


cl;{uPPCross 0} 
c2; 


{ 

Subroutine : getSTFormMapBase 

Entry : otLo# = Form Oop (getSTFormMapBase) — SourceForm 

otLow > Form BltMap Oop (getSTFormMapBasal) --- DestForm 
L2 : returnllnk 

Exit : templHIgh. templLow has the map base 
otLow : Oop for bitmap 

temp2Low : the Words No. for 1 horizontal line, 
cycle: Entry cl. Exit cl 

} 

getSTFormMapBase1: { for DESTINATION FORM } 

Xbus uBooleans, XLDIsp, L3 checkSource, c 3; { des tB1tMap - current BltMap ? } 

Q uDestHelghtA. BRANCH [destNEQCurrent, destEQCurrent. 1], cl- 

destNEQCurrent: 

{destWIdth, destHelght have been already checked whether they would be greater than 1024, 1010 resoectlvelv 1 
temp2Low uDestWIdthA, CALL [checkWIdthAndHelght], c2; y * 

destEQCurrent: 

GOTO [yesCurrent], C 2 . 


getSTFormMapBase: (for SOURCE FORM } 

temp3Low uCurrentDIspBItMap, LI getMap, 
CALL [otMap2BankO], 


MAR templLow [templHIgh, templLow + formMapBaselndexl, 

LI getwidth, 

getMapBase2: 

templLow templLow + 1, 

BRANCH [noPCInGetMapBase2, yesPCInGetMapBase2, 1], 


c2: 
c3; 


cl, at [getMap, 10, otMap2BankO-return]; 


c2; 


yesPCInGe tMapBase2: 

templLow templLow + OFF, 

MAR [templHIgh, templLow + 0], GOTO [getMapBase2], 


noPCInGetMapBase2: 

otLow MD, XDIsp, { get SourceForm BltMap Oop } c 3 ; 

getMap8ase3: 

MAR [templHIgh, templLow + 0], DISP4 [sourceBI tMapOop. OC], cl; {**■***♦* + } 


[] temp3Low xor otLow, ZeroBr, L3 checkSource, GOTO [bltMapOop], 
[] temp3Low xor otLow. ZeroBr, L3 checkSource, GOTO [bltMapOop], 
[] temp3Low xor otLow, ZeroBr, L3 checkSource, GOTO [bltMapOop], 


c2, at [QD, 10, source81tMapOop]; £** + *«■***} 
c2, at [OE, 10, sourceBItMapOop]; {+******+} 
c2, at [OF, 10, sourceBItMapOop]; £*** + **•**} 


bltMapOop; 

temp2Low MD, XHDIsp, BRANCH [{CALL} checkSmal1Int2cl, yesCurrentl], c3; 


noCurrentl: 

MAR [templHIgh, templLow + 0], LI getHelght, 
temp3Low temp2Low, CALL [checkSmal1Int2] , 

noCurri»nt2: 

Q temp2Low, LI getMapBase. {Q » Form.Height} 

temp2Low temp3Low, CALL [checkWIdthAndHelght], 


cl. at [getwidth, 10, checkSmal1Int2-return]; 
c2i { for checkWIdthAndHelght routine} 


cl, at [getHelght. 10 . checkSmal!Int2-return]; 
c2; {temp2Low a Form.Height} 


{ 


At this point, Q <== INT(((B1tW1dth-l)/10) + l )*he1ght, temp2Low = Words /horizontal 
Also. otLow = Bitmap Oop(Source, Destination)} 


line. 


temp3Low Q + objectHeaderSIze, CALL [otMap2BankO}, 
{otLow - BltMap Oop } 

noCurr«nt4: 

MAR templLow [templHIgh, templLow + sIzeFleldOffset], 
getMapBase4: 

BRANCH [noPCGetMapBase4, yesPCGetMapBase4, 1], 


c3, at [checkSource, 10 , checkWIdthAndHelght-return]; 

cl, at [getMapBase, 10, otMap2BankO-return]; 
c2; 


yesPCGetMapBase4: 

templLow templLow + OFF + 1, 

MAR [templHIgh, templLow + 0], GOTO [getMapBase4], 


noPCGetMap8ase4: 
Q MD, 


c3; { get BltMap Size } 
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noCurrentS: 

[] temp3Low xor Q, ZeroBr, {BltMapSize * (width * height) ? } cl; 

templLow templLow + 2, { point the actual address of BltMap } 

BRANCH [funnyBItMapSIze, correctBItMapSIze], c2; 


correctBItMapSIze: 

L2D1sp, c3; 

RET [getSTFormMapBase-return], cl; 


yesCurrentl: 

CANCELBR [$, OF], cl; 

Noop, c2j 

yesCurrent: 

temp2Low 40. L2D1sp, c3; { INT [(1024 + 15)/16] - INT [64.9xx] =■ 64} 

yesCurrent2: 

templHIgh templLow (templLow xor templLow) LRotO, 

RET [getSTFormMapBase-return], cl; { point the Low real memory } 


L2 prlmFall, GOTO [prlmltlveFaHB1tBlt3], c2, at [OC. 10, sourceBItMapOop]; 


funnyBItMapSIze: 

L2 prlmFall, GOTO [prlmltlveFa ilBItBItl], c3; 


{ 


Subroutine : 

; bbtMultlply 


C A+B 
Entry : 

temp2Low 

= A 


Q 

B 


L2 

a return link 

Exit: 

Q 

a result 


templLow, 

temp3Low, sourcelndex are smashed 


entry: cl, c2, c3 exit : cl 

} 


bbtMultipiy2: 


Noop, 

c2; 

bbtMultipiy3: 


Noop, 

c3; 


bbtMultlply: 

templLow 0, cl; { product } 

sourcelndex 10, c2; { loop counter for mult-loop } 

bbtMulLoop: 

[] Q and 1, NZeroBr, c3; 

sourcelndex sourcelndex - 1, ZeroBr, 

BRANCH [bbtMulDIgltO, bbtMulDlgltl], cl; 


bbtMulOlglto: 

templLow OARShlftl (templLow + 0), BRANCH [bbtMulLoop, bbtMulEnd], c2; 


bbtMulOlgltl: 

templLow OARShlftl (templLow + temp2Low), 

BRANCH [bbtMulLoop, bbtMulEnd], c2; 


bbtMulEnd: 

Q - Q, L2D1sp, 


c3; 


RET [bbtMultlply-return], 


cl; {Result is Q} 


{ Subroutine: getSeveralMasks 
description : 
sourcelndex : 

LI : 

Exit: skew : 

uMaskl : 

uMask2(temp2Low) : 


calculate the several masks ( skew, maskl, mask2 ) 

uW - 1 

return Link 

skew 

maskl 

mask2 


Note: smashed register — templLow, temp2Low 


Entry: cl, Exit: cl 

} 


getSeveralMasks: 

templLow uDX, L3 getMaskl, 
temp3Low templLow and OF, 


cl; 

c2; { dx and 15 } 
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temp3Low 10 - tamp3Low, 

uStartBIts tamp3Low, CALL [makeRIghtMasks], 
uMaskl temp2Low, 

sourcelndex templLow + sourcelndex, L3 getMask2, 
temp3Low sourcelndex and OF, 

temp3Low OF - temp3Low, CALL [makeRIghtMasks], 

uMask2 ~temp2Low , 

temp3Low uSX, L3 computeSkewMasks, 

tempSLow temp3Low - templLow, 

temp3Low temp3Low and OF, ZeroBr, L3 computeSkewMasks, 
skew temp3Low LRotO, BRANCH [skewNonZero, skewZero], 


skewNonZero: 

temp3Low 10 - temp3Low, 

sourcelndex uBooleans, CALL [makeRIghtMasks], 
uSkewMask temp2Low, 

sourcelndex sourcelndex and 87, GOTO [storeSkewZewalndl], 


skewZero: 

sourcelndex uBooleans, 

uSkewMask sourcelndex xor sourcelndex, 
sourcelndex sourcelndex or 8, 
storeSkewZewalndi: 

uBooleans sourcelndex, GOTO [getSeveralMasksRet], 


c3; {16 - (dx and 15)} 

cl; 

cl, at [getMaskl, 10, makeRIghtMasks-return]; 
c2; { sourcelndex ■ uW - 1 } 
c3; { (dx+W-1) bltAnd; 15} 

cl; { 15 - ((dx+W-1) bltAnd: 15)} 

cl, at [getMask2, 10, makeRIghtMasks-return]; 

c2; { to make skewMask} 

c3; 

cl; 
c2; 


c3; 
cl; 

cl, at [computeSkewMasks, 10, makeRIghtMasks-return]; 
c2; 


c3; 

cl; 
c2; 

c3; 


{restoreStatus 

Entry : cl, c2, c3, Exit: c2 
return Link: L2 

} 

restoreStatus: 

ipLow uSaveIPL, cl; 

templLow uSavelPH, c2; 

IpHIgh templLow LRotO, c3; 

stackLow uSaveStackL, cl; 

stackHIgh uSaveStackH, c2; 

homeLow uSaveHomeL, c3; 

templLow uSaveHomeH, L2D1sp, cl; 

homeHIgh templLow LRotO, RET [restoreStatus-return], c2; 


{ 

Subroutine: bbtCheckRange 
Entry: 

destAddrLow : 

souuceAddrLow : 

sourcelndex : 

temp2Low : 

temp3Low : 

Exit: 


dastX 
sourceX 
destWIsth 
cllpx 
clIpWldth 


sourceAddrLow : sx or sy 
destAddrLow : dx or dy 
sourccelncex : w or h 
returnLInk : L2 
entry: cl, exit: cl 


or destY 
or sourceY 
or destHelght 
or clIpY 
or clIpHelght 


bbtCheckRange: 

[] destAddrLow - temp2Low, NegBr, 

Q temp2Low - destAddrLow, BRANCH [destXGE, destXLT], 


cl; 

c2; {cllpx - dastX } 


destXLT: {no} 

destAddrLow temp2Low, 

sourceAddrLow sourceAddrLow + Q, 
sourcelndex sourcelndex - Q, 
destXGE: {yes} 

Q destAddrLow + sourcelndex, 
checkRIghtRange: 

temp2Low temp2Low + temp3Low, l.2D1sp, 

[] temp2Low - Q, NegBr, BRANCH [checkX, checkY, 


c3; { dX cllpx } 

cl; { sX sourceX + (cllpx - destX)} 
c2; { w width - (clIpX - destX)} 

c3; { dx + w } 

cl; { clIpX + clIpWldth } 

OE], c2; {(dx+w) > (clIpX+clIpWldth) ??} 


checkX; 

templLow uOestWIdthA, BRANCH [clIpGEOnRIghtSIde. clIpLTOnRIghtSIde], c3; 
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check'/: 


templLow uDastHelghtA, BRANCH [clIpGEOnRIghtSIde, clIpLTOnRIghtSIde], c3; 


clIpGEQnRIghtSIde: { cl 1pX+clIpWldth >■ dx+w } 

Q templLow - Q, NegBr, 

BRANCH [rangeLEDestForml, rangeGTDestForml], 


cl; { dx+w > destWIdth ?} 
c2; 


rangeLEDestForml: 

GOTO [nextStepl], 


c3; 


rangeGTDestForml; 

sourcelndex sourcelndex + Q, GOTO [nextStepl], c3; 


clIpLTOnRIghtSIde: { clipX+clipWidth < dx+w } 

[] templLow - temp2Low, NegBr, cl; 

temp2Low Q - temp2Low, {temp2Low = (dx+w) - (clIpx+clIpWldth)} 

BRANCH [rangeLEDestForm2, rangeGTDestForm2], c2; 


rangeL.EDestForm2: 

sourcelndex sourcelndex - temp2Low, GOTO [nextStepl], c3; 


rangeGTDestForm2: 

Q Q - tamplLow, { Q * (dx+w) - Form.Width } c3; 

rangeL,TD9stForm21: 

sourcelndex sourcelndex - Q, GOTO [nextStep], cl; 


nextStepl: 

Noop, 

nextStep: 

Xbus uBooleans, XLDisp, 

BRANCH [noCurrentlnCheck, yesCurrentlnCheck, 1], 


cl; 

c2; { check DestForm = currentScreen?} 
c3; { dx < 0 ?? } 


yesCurrentlnCheck: 

[] destAddrLow, NegBr, cl; 

BRANCH [destNoNegatlve, destYesNegatlve], c2; 


{ If destForm => currentScreen, and dx(dy) < 0, we have to make dx(dy) * 0 and ajust the sx(sy), w(h) } 


destYesNegatlve: 

sourceAddrLow sourceAddrLow - destAddrLow, c3; 

sourcelndex sourcelndex + destAddrLow, cl; 

destAddrLow 0, c 2; 

destNoNegatlve: 

Noop, c3; 

noCurrentlnCheck: 

[] sourceAddrLow, NegBr, cl; 

BRANCH [noSourceNegatlve, yesSourcaNegatlve], c2; 

noSourceNegative: 

L2Disp, c3; 

RET [bbtCheckRange-return], cl; 

yeSvSourceNegatlvQ; 

destAddrLow destAddrLow - sourceAddrLow, c3; 

sourcelndex sourcelndex + sourceAddrLow, cl; 

sourceAddrLow sourceAddrLow xor sourceAddrLow, 

GOTO [noSourceNegatlve], c2; 


{ Subroutine: calSkewWord — 4 click } 

Entry : cl 

sourcelndex : prevWord 
Q : uHDIr 

Exit : c3 

temp2Low : skewWord 
Q : New prevWord for next using 

otl.ow : smashed 

> 

calSkewWord: 

MAR [sourceAddrHIgh, sourceAddrLow + 0], cl; 

calSkewWordl: 

sourceAddrLow sourceAddrLow + Q, c2; 

Q MD, C 3; { get this word } 
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uPrevWord Q, 

cl; 

Noop, 

c2; 

Noop. 

c3; 


calSkewWord2: 

sourcelndex sourcelndex and uSkewMask, 

Q ~uSkewMask and Q, 
calSkewWord3: 

Q sourcelndex or Q, Xbus skew, XDIsp, 
bbtRotation: 

sourcelndex LRotl Q, 0ISP4 [bbtRot], 


cl; { prevWord prevWord bitAnd: skewMask } 
c2;{ thlsWord bitAnd; skawMaks bltlnvewrt } 

c3; 

cl; 


L2D1sp, temp2Low 
L2D1sp, temp2Low 
L2D1sp, temp2Low 
L2D1sp, temp2Low 


Q. GOTO [bbtShlftO], 
sourcelndex, GOTO [bbtShlftO], 

LRotl sourcelndex , GOTO [bbtShlftO], 
RRotl Q, GOTO [bbtSh1ft4], 


c2, 

at 

[ 

0, 

10, 

bbtRot]; 

c2, 

at 

c 

1 , 

10, 

bbtRot]; 

c2, 

at 

c 

2, 

10, 

bbtRot]; 

c2, 

at 

c 

3, 

10, 

bbtRot]; 


L2D1sp, temp2Low 
L2D1sp, temp2Low 
L2D1sp, temp2Low 
L201sp, temp2Low 


Q, GOTO [bbtShim], 

LRotl Q, GOTO [bbtSh1ft4], 

LRotl sourcelndex, GOTO [bbtSh1ft4], 
RRotl Q, GOTO [bbtSh1ft8], 


c2, 

at 

c 

4. 

10, 

bbtRot]; 

c2, 

at 

c 

5. 

10, 

bbtRot]; 

c2, 

at 

c 

8, 

10, 

bbtRot]; 

c2. 

at 

[ 

7, 

10, 

bbtRot]; 


L2D1sp, temp2Low 
L2D1sp, temp2Low 
L2D1sp, temp2Low 
L2D1sp, temp2Low 


Q. GOTO [bbtSh1ft8], 

LRotl g, GOTO [bbtSh1ft8], 

LRotl sourcelndex, GOTO [bbtSh1ft8], 
RRotl Q, GOTO [bbtShlftl2], 


c2, at [ 8, 
c2, at [ 9, 
c2, at [OA, 
c2, at [OB, 


10, bbtRot]; 
10, bbtRot]; 
10, bbtRot]; 
10, bbtRot]; 


L2D1sp, temp2Low 
L2D1sp, temp2Low 
L2D1sp, temp2Low 
L2D1sp, temp2Low 


0, GOTO [bbtSh1ftl2], 

LRotl g, GOTO [bbtSh1ftl2], 

LRotl sourcelndex, GOTO [bbtSh1ftl2], 
RRotl Q, GOTO [bbtShlftO], 


c2, at [OC, 
c2, at [OD, 
c2, at [OE. 
C2, at [OF, 


10, bbtRot]; 
10, bbtRot]; 
10, bbtRot]; 
10, bbtRot]; 


bbtShlftO: 

RET [calSkewWord-return], 


c3; 


bbtShlft4; 

temp2Low tamp2Low LRot4, RET [calSkewWord-return], 


bbtSh1ft8: 

temp2Low temp2Low LRot8, RET [calSkewWord-return], 


bbtSh1ftl2: 

temp2Low temp2Low LRotl2, RET [calSkewWord-return], 


c3; 


c3; 


c3; 


[Subroutine: getHalftoneWord - 2-cllcks} 

{ 

Entry: 

c2, 

sourcelndex : vertical direction 

Exit: 

cl, 

sourcelndex: halftoneWord 

> 

getHalftoneWord: 

temp2Low uDY, c2; 

temp3Low temp2Low and OF, c3; { dy bitAnd; 15} 


MAR [halftoneAddrHIgh, halftoneAddrLow + temp3Low], cl: 

temp2Low temp2Low + sourcelndex, 

BRANCH [noPCInGetHWord, yesPCInGetHWord, 1], c2;{ dy dy + vDir} 


yesf’CInGetHWord: 

halftoneAddrLow temp3Low + halftoneAddrLow, c3; 

MAR [halftoneAddrHIgh, halftoneAddrLow + 0], cl; 

halftoneAddrLow halftoneAddrLow - temp3Low, c2; 

noPCInGetHWord: 

temp2Low MD, uOY temp2Low, LIDIsp, c3; 

uHalftoneWord temp2Low, RET [getHalftoneWord-return], cl; 


{ 

Subroutine: 
Entry: 

Exit : 

Mote : 


checkWidthAndHeight 

temp2Low a Form.Width 

Q = Form.Height 

L3 = return Link 


Width * Height > 64640 then prlmltlveFall, otherwise return 

templLow, otLow, Q, sourcelndex is smashed by using bbtMultlply routine. 
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checkWIdthAndHelght: 

temp2Low temp2Low - 1, c3; 

checkWIdthAndHelghtl: 

temp2Low temp2Low and ~0F, L2 wldthAndHelght, 
temp2Low tamp2Low LRotl2 + 1, 

CALL [bbtMultlply], 

smashed} 

(On Smalltalk-80 on 1108X(k1ku-X), the largest size of BltMap Is 04640 word, l.e. 1024*1010/10. If user try to create the form of size 
with greater than 64640, automatlvally system modify the size with 64640, and not modify the width, height of the corresponding Form. So 
we may have the trouble, since copyBIts primitive refers Form.width, height when actually transferring the Bit Block.} 

{Why the reason above, we check It describing below} 

[] Q, NegBr, c2, at [wldthAndHelght. 10, bbtMultlply-return]; 

tempiLow OFC, 

BRANCH [checkW1dthAndHeight4, maybeLargerThanMaxSize], c3; 


cl; 

c2; { width INT((b1tW1dth - 1)/10) + 1} 

c3; { Q = width * height. templLow, sourcelndex are 


maybeLargerThanMaxSize; 

templLow templLow LRot8, 
templLow templLow or 80, 

[] templLow - Q, NegBr, 

L3D1sp, BRANCH [checkW1dthAndHe1ght41, overBItMapMaxSIze], 


c 1; 

c2; {64640 
c3; 

cl; 


FC80 * x => 1024*1010/16} 


checkW1dthAndHe1ght4: 

L3D1sp, cl; 

checkW1dthAndHe1ght41; 

RET [checkWIdthAndHeight-return], c2; 


overBItMapMaxSIze: 

temp2Low 0F1, CANCELBR [$, OF], c2; 

L2 prlmFall, GOTO [prlmltlveFallBItBltl], c3; 


{ Edit history: 

22-Jan-86 16:17:09 
21-Jan-86 16:46:27 
17-Dec-85 9:00:10 

5-NOV-86 9:12:07 

oop is not current 
4-Nov-86 11:31:18 
2-MOV-8B 20:09:58 
27-Sep-86 13:49:07 
13-Sep-85 11:30:53 
20-Jun-85 9:52:54 

10-Jun-86 19:38:06 


Tokunaga.Iwafx 
Tokunaga.Iwafx 
Tokunaga.Iwafx 
Tokunaga.Iwafx 
display bltMap. 

Tokuanga.Iwafx 
Tokunaga.Iwafx 
Sakaklbara.Iwafx 
Tokuanga.Iwafx 
Tokunaga.Iwafx 
Tokunaga.Iwafx 


modify getSTFormMapBase for stretch 

modify the chsckWIdthAndHelght and getSTFormMapBase 

add the checking routine for dx < 0 or not In bbtCheckRange when DestForm - CurrentScreen 
add the checking routine for BltMap.Size = (Width*He1ght) in getSTFormMapBase when bltMap 

add the checking DestForm.width in bbtCheckRange routine, 
add checkSma11Int2 and checkWIdthAndHelght routine 
bug fix CANCELBR 

remove "updateCursor" routine and RegDefs in checkMesalnterrupt routine, 
add checkSmalllnt from bbt.mc 
add bltShlft subroutine } 
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{ MerooryManglement.me 


Object creation, reference counting, stabilization, and other memory management stuff for Rum, the Dandelion Smantalk-80 microcoded 
virtual machine. 

by P McCullough, J Trow 

20-Jan-86 20:46:14 

Copyright 1083, 1984, 1985, 1986 by Xerox Corporation. All rights reservad. } 


{for each of these entry points, uClassToInstantiate must be the oop of the class, temp3Lov/ is the size in words or bytes. temp3High is 
the return linkage register} 


createlns tanceWithPointers: 

temp2Low nllPointer, cl; 

tempi Low hasPoiriters, GOTO [createlnstance], c2; 

createlnstanceWithBytes: 

temp?Low 0, cl; 

[] temp3Low LRotO, XDisp, c2; 

temp3Low tomp3Low + 1, BRANCH [$, byteCountlsOdd, 0E], c3; 

byteCouutlsEven: 

templLow evonBytes, GOTO [byteShift], cl; 

byteCountlsOdd: 

templLow oddBytes, ' cl; 

byteShift: 

temp3Low RShiftl ternp3Low, SE 0, GOTO [createlnstance], c2; 

createlnstanceWithWords; 

temp2Low 0, cl; 

templLow hasWords, GOTO [createlnstance], c2; 

createLargePositlveInteger: 

templLow classLargePositIvelntegerPointer, cl; 

uClassToInstantiate templLow, c2; 

GOTO [createlnstancoWithBytes] c3; 


{ createlnstance 

Create a new instance of a given class. 

input: templLow is. the odd byte and pointer bits of the delta word 
teinp2Low Is the Initial value of the fields of the instance 
temp3Low is the size of tho instance in words not Including the header 
uClassToInstantiate is the class of the new instance 
temp3High is the return link 

output: uNewObject Is the new instance 

uNewObjectHigh/Low is the address of the new instance 
uRequestedSize is the size of the new Instance 

smash: otLow, templHIgh/Low, temp2H1gh/Low, temp3High/Low, 0, uPredecessor, uFleldType, uDefault, uCurrentFreeChunkOop, 

uNextFreeChunk, LI, L2, } 


createlnstance: 

uFleldType templLow 

{save these for initializing the object and its ot entry}, c3; 

uDefault temp2Low, cl; 

temp3Low temp3Low + objectHeaderSize, CarryBr, c2; 

0 objectSizeTestLimlt, BRANCH [$, masslveSenll1ty2], c3; 

[] temp3Low + Q, CarryBr, cl; 

BRANCH [$, requestedSizeTooBIg], c2; 

temp2H1gh uRumRecordHigh, c3; 

temp2Low uRumRecordLow, cl; 

templLow largestFreeChunkSize, c2; 

[] temp3Low - templLow, CarryBr, c3; 

uRequestedSIze temp3Low, BRANCH [$, useBigFreeList], cl; 

temp2Low temp2Low + freeListsOffset, {try specific list} c2; 

Noop, c3; 

MAR [temp2H1gh, temp2Low + temp3Low], cl; 

CANCELBR [$, 0], C 2; 

otLow MD, L2 creatinglnstance {for nextFreeChunk}, c3; 

Noop, cl; 

Noop, c2; 

[] otLow and 3, ZeroBr, c3; {temp} 
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uNewObject otLow, BRANCH [$, tryBigLIst], 

LI gettingNextFreeChunk {for otMap2 inside nextFreeChunk}, 
CALL [nextFreeChunk], {got one) 

MAR [temp2High, temp2Low + terop3Low] {update free list head} 
MDR 0, CANCELBR [$, 0], L00PH0LE[wok], 

0 templHigh, (save new object’s address) 

uNewObjectHigh Q, 
uNewObjectLow templLow, 

GOTO [allocate]. 


Cl; 
c2; 

cl, at [creatinglnstance, 10, noxtFreeChunk-return]; 

c2; 

c3; 

cl; 
c2; 
c3; 


tryBigList: 

temp2Low uRumRecordLow, GOTO [useBlgFreeListA], c2; 


(upon entry, temp2lligh/Low contains the rum record address. uRequestedSize is valid. temp3Low is the requested size} 
useBigFreoLlst: 

Noop, C 2; 

useBigFroeListA: 

uPredecessor 0 {should be niIPointer}, 

L.1 gettingNextFreeChunk (for otmap call in nextFreeChunk}, c3; 

MAR [temp2High, temp2Low + bigFreeListOffset'J, 

1.2 consider ingBIgChunks, cl; 

temp3Low tenip3t.ow + objectHeaderSize, CarryBr, 

{yields ininlmurn splittable block size} CANCELBR [$, 0], c2; 

otLow MO (current free chunk}, BRANCH [$, massiveSenilltyA], c3; 


considerNextBigFreeChunk: 

Noop, 

Noop, 

[] otLow and 3, ZeroBr, 

uNewObject otLow, BRANCH [$, outOfChunks], 
uCurrentFreeChunkOop otLow, CALL [nextFreeChunk], 

uNextFreeChunk Q {remember next free chunk}, 
templLow templLow + sizoFieldOffset, 

Noop, 

MAR [toroplHigh, templLow + 0], 

Noop, 

Q MD {size of current free chunk}, 

[] 0 xor uRequestedSIze. ZeroBr, 

[] Q - tetnp3Low, CarryBr, BRANCH [$, axactFIt], 

BRANCH [$, canSubdlvide], 

iterate: 

uPredecessor otLow, 

Noop, 

otLow uNextFreeChunk, GOTO [considerNextBigFreeChunk], 


exactFit: 

templLow templLow - sizeFieldOffset, CANCELBR [$, 1], 

Q templHigh, 
uNewObjectLow templLow, 
uNewObjectHigh Q, GOTO [splice], 


cl; 

C2 ; 

c3; {temp} 

cl; 
c2; 

cl, at [consideringBigChunks, 10, nextFreeChunk-return]; 

c2; 

c3; 

cl; 

C2; 
c3; 

cl; 

c2; 
c3; 


cl; 
c2; 
c3; 


c3; 

cl; 
c2; 
c3; 


canSubdlvide: 

temp3Low uRequestedSIze, cl; 

temp3Low {new size} 0 {current size} - temp3Low {requested size}, c2; 

0 templHigh (part of new object’s address}, c3; 

MAR [temp2High, temp2Low + freePointersOopOffset], cl; 

uNewObjectHigh 0, CANCELBR [$, 0], c2; 

otLow MD {first free oop}, c3; 

Noop, cl; 

Noop, c2; 

[] otLow and 3, ZeroBr, c3; {temp} 

uNewObject otLow, BRANCH [$, outOfOops], cl; 

Q templLow - sizeFieldOffset, LI splIttlngFreeChunk, c2; 

0 {object address} 0 {chunk address} + temp3Low {chunk size}, c3; 


{write the new size of the current free chunk (templHigh/Low still pointing at its size field)} 


MAR [templHigh, templLow + 0], 

MDR temp3Low {new chunk size}, 
uNewObjectLow Q, 

CALL [getOtAddress] {free oop link}, 

MAR [temp2High, temp2Low + freePointersOopOffset], 

MDR templLow {new free oop head}, LOOPHOLE [wok], CANCELBR [$, 
temp2High splIttlngFreeChunk, 

templLow uNewObjectHigh, CALL [putOtFlags], 


cl; 

C2; 

c3; 

cl; 

cl, at [splittIngFreeChunk, 10, getAddressReturn]; 
0], C2; 

c3; 

Cl; 
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templLow uNowObjectLow, CALL [putOtAddress], 

templLow {chunk address} templLow - temp3Low, 
temp2 Low TargestFreeChunkSizeLessOne, 

[] tomp3Low {chunk size} - temp2Low, CarryBr, 

{should we move the current free chunk to a small free chunk list?} 

otLow uCurrentFreeChunkOop, BRANCH [$, ItsFineWhereltls], 

1.1 moveFromBigToSmall, 

CALL [addToFreeChunkLIst] {this call returns directly to splice}, 


cl, at [splittingFreeChunk, 10, putFlagsReturn]; 

cl, at. [spl ittingFreeChunk, 10, putAddressRetum]; 

c2; 

c3; 


cl; 
c2; 
c3; 


splice: 

otLow uPredecessor, LI splicIngBigFroeLlst, 

Noop, 

Noop, 

[] otLow and 3, ZeroBr, 

temp2High uRuntRecordHigh, BRANCH [didHaveProdecessor, 
temp2Low uRumRecordLow, (no predecessor} 


cl, at [moveFromBigToSmall, 10, addFreeChunkReturn]; 

c2; 

c3; 

cl; {temp} 

$], c2; 

c3; 


MAR [teinp2High, tempZLow + bigFreeLis tOf Fset] , GOTO [ 1 inkNcxtChunk], cl; 


didHaveProdecessor: 

CALL [otMap2], 

templLow templLow + chunkLInkOffsot, 
Noop, 

Noop, 


c3; 

cl, at[splIcingBigFreeList, 10, otMap2-return]; 

c2; 

c3; 


MAR [templlllgb, templLow + 0], 

1InkNextChunk: 

MOR uNextfreeChunk, LOOPHOLE [wok], CANCELQR [bigListWrapup, 0], 


cl; 
c2; 


itsFineWhereltls: 

Noop, c2; 

bigListWrapup: 

otLow uNewObject, GOTO [allocate], c3; 

outOfChunks: 

GOTO [massIveSenility], c2; 

outOfOops: 

Noop, c2; 

massIveSenility: 

Noop, c3; 

massIveSenility2: 

GOTO [bytecodeFailed], cl; 

massIveSenil1ty4: 

CANCELBR [bytecodeFailed, OF], cl; 

requestedSIzeTooBIg: 

GOTO [massIveSenil1ty2], c3; 


{Adjust the memory and oop levels and signal Mesa If either is below its alert level and Mesa has not yet been signalled. 
(((wordLevel < wordAlertLevel) or; [oopLevel < oopAlertLevel]) and: [alreadyAlerted = 0]) ifTrue: [signalAlerl 1. MesalntRq]} 


allocate: 

tempZHigh uRumRecordHIgh, cl; 
temp2Low uRumRecordLow, c2; 
Noop, c3; 

MAR [temp2High, temp2Low + oopLevelLowOffset], cl; 
CANCELBR [$, 0], c2; 
temp3Low MD, c3; 

MAR [temp2H1gh, temp2Low + oopLevelLowOffset], cl; 
MDR temp3Low temp3Low - 1, CANCELBR [$, 0], LOOPHOLE [wok], c2; 
Noop, c3; 

lowOopTest: 

MAR [temp2H1gh, temp2Low + oopAlertLevelLowOffset], cl; 
CANCELBR [$, 0], C 2; 
0 MD, c3; 

Noop, cl; 
0 temp3Low - Q, CarryBr, c2; 
BRANCH [$, decreaseWordLevel], c3; 

MAR [temp2High, temp2Low + alreadyAlertedOffset] , cl; 
CANCELBR [$, 0], c2; 
0 MD, c3; 
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[] q, ZeroBr, C l ; 
BRANCH [decreaseWordLevel2, $1. c2 • 
Noop, c 3; 

MAR [temp2H1gh, temp2Low + slgnalAlertOffset], cl- 
MDR 1, CANCELBR [$, 0], LOOPHOLE [wok], c 2; 
MesalntRq {run mesa before next bytecode}, GOTO [decreaseWordLevel], c3; 


decreaseWordLevel2: 

Noop, c 3 ; 

decreaseWordLevel: 

MAR [tomp2lligli, temp2Low * wordLevelLowOffset], cl; 

temp3Low uRequestedSizo, CANCELBR [$, 0], c2■ 

0 MD, c3; 

MAR [temp21Hgh, temp2l.ow + wordLoveILowOffset], cl; 

MDR temp3Low Q - temp3Low, CANCELBR [$, 0], 

LOOPHOLE [wok], CarryBr, c2; 

BRANCH [$, lowMomoryfestlllgliGetDaU], c3; 

wordLovolBorrow: 

MAR [temp2High, tcmp2Low + wordLevalHighOffset], cl; 

CANCELBR [$, 0], c 2• 

0 MB. c3; 

MAR [tenip2H1gh, temp21.ow + wordLovelHighOffset], cl; 

MDR g - 1, CANCELBR [$, 0], LOOPHOLE [wok], c2; 

teinplLow g - 1, GOTO [lowMemoryTesttlighHavoData], c3; 


lowMemoryTestllighGetData: 

MAR [temp2Higli, temp2Low + wordLevelHIghOffsot], cl; 
CANCELBR [$, 0], ' c 2. 
tempiLow MD, c 3; 

lowMomoryTcstHiglHlaveData: 

MAR [temp2IMgh, temp2Low + wordAlertLevolHIghOffset], cl; 
CANCELBR [$, 0], c 2 ; 
Q MD, c3; 

0 0 - templLow, CarryBr, cl- 
[] 0, ZeroBr, BRANCH [reallyAllocatel, $], c2; 
BRANCH [$, lowMomoryTestLow], c3; 

MAR [tomp2H1gh, temp2Low + alreadyAlertedOffset], cl; 
CANCELBR [$, 0], C 2• 
0 MO, c3 ; 

[] o, ZeroBr, cl; 
BRANCH [lowMemoryTestLow2, $], c2; 
Noop, c3; 

MAR [temp2H1gh, temp2Low + slgnalAlertOffset], cl; 
MDR 1, CANCELBR [$, 0], LOOPHOLE [wok], c 2; 
MesalntRq {run mesa before next bytecode}, GOTO [reallyA11ocate3], c3; 


lowMemoryTestLow2: 

Noop, c3; 
lowMomoryTestLow; 

MAR [temp2H1gh, temp2Low + wordAlertLevelLowOffset], cl; 
CANCELBR [$, 0], c 2; 
0 MD, c3; 

Noop, cl; 
0 temp3Low - Q, CarryBr, c2; 
BRANCH [$, reallyAllocate3], c3; 

MAR [temp2H1gh, temp2Low + alreadyAlertedOffset], cl; 
CANCELBR [$, 0], c 2; 
0 MD, c3; 

[] g, ZeroBr, cl; 
BRANCH [reallyAllocate2, $], C 2; 
Noop, c3; 

MAR [temp2H1gh, temp2Low + slgnalAlertOffset], cl; 
MDR 1, CANCELBR [$, 0], LOOPHOLE [wok], c2; 
MesalntRq {run mesa before next bytecode), GOTO [reallyAllocate3], c3; 


reallyAllocatel; 

CANCELBR [reallyAllocate3, 1], c3; 

realllyAllocat«2; 

Noop, c3; 

rea11yAUocate3: 

Noop, cl; 

templHIgh uNewObjectHigh, c2; 

templLow uNewObjectLow, c3; 

temp3Low uRaquestedSIze, cl; 
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temp3Low tempiLow + temp3Low, {end of the object +1) c2; 
templLow templLow + deltaWordOffset, c3; 

{Initialize the object header now} 

MAR [templHIgh, templLow + 0], cl; 
MDR uFieldType, {set delta word} c2; 
templLow templLow + offsetFromDeltaWordToSizeField, c3; 

MAR [templHigh, templLow + 0], cl; 
MDR uRequestedSize, c2; 
templLow templLow + offsetFromSIzeFieIdToClassFleld, c3; 

MAR [templHigh, templLow +0], cl; 
MDR uClassToInstantlate, c2; 
{ok, object header is done, now zap the object body} 

templLow templLow + offsetFromClassFleldToFirstField, c3; 

temp2Low uDefault, cl; 
Noop, c2; 
[] templLow - temp3Low, 7.ero8r, c3; 

initial izeObjectBody: 

MAR [templHigh, templLow + 0], BRANCH [$, zapped], cl; 
MDR ternp2Low, templLow templLow + 1, c2; 
[] templLow - tcmp3L.ow, ZeroBr, GOTO [initial IzoObjectBody], c3; 


zapped: {the object header and object body aro completely Initialized, now fix up the object table entry) 

Noop, c2; 

temp3Low temp3High {return link}, L2 creatingAnlnstance, c3; 


tomp2lligh newObjectMeader, CALL [getOtFlags], 
templLow templLow and 8F, CALL [putOtFlags], 

temp2Low temp3Low {save return link}, CALL [addToZeroCountTable], 


cl; 

cl, at [newObjectHeador, 10, getFlagsRoturn]; 
cl, at [newObjectHeader, 10, putFlagsReturn]; 


Noop, 

addToZoroCountTableReturn]; 

LI upClassAtlnstantiatlon, 

otLow uClassToInstant iate, XDisp, CALL [refi], 

otLow uNewObject, 

Xbus temp2Low LRotO, XDisp, 

RET [createlnstance-return], 


cl, at [creatingAnlnstance, 10, 

c2; 
c3; 

cl, at [upClassAtlnstantiation, 10, reMReturn]; 
c2; 
c3; 


{ nextFreeChunk 

Return the next object on a free list. Free objects are linked through their class fields. 

Input: otLow is the current object 

otHigh Is the high part of the object table base address 
LI Is the return link for otMap2 
L2 Is the return link 


output: Q Is the next object 

templHigh/Low Is the address of the current object 


smash: } 

nextFreeChunk: 

CALL [otMapE], 

templLow templLow + chunkLInkOffset, 

Noop, 

Noop, 

MAR [templHigh, templLow + 0], 

templLow templLow - chunkLInkOffset, L2D1sp, 

0 MD, RET [nextFreeChunk-return], 


c3; 

cl, at [gettlngNextFreeChunk, 10, otMap2-return]; 

c2; 

c3; 

cl; 
c2; 
c3; 


{ addToFreeChunkLIst 

Add an object to the appropriate free list. 

Input: otLow Is the object 

templHIgh/Low is the address of the object 

temp3Low is the Index of the list (size of the object for small objects) 
uRumRecordHigh/Low is the Rum communications record base address 
LI Is the return 1 ink 

output: temp2H1gh/Low Is the Rum communications record base address 
smash: 0 } 
addToFreeChunkLIst: 

temp2H1gh uRumRecordHIgh, cl; 

temp2Low uRumRecordLow, c2; 
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temp2Low temp2Low + freeLlstsOffset, c3; 

MAR [temp2H1gh, temp2Low + temp3Low], cl; 
templLow templLow + chunkLInkOffset, CANCF.LBR [$, 0], c2; 
0 MD {current free list head), c3; 

MAR [templHIgh, templLow + 0}, cl; 
MDR 0, {link new object to old list head} c2; 
Noop, c3; 

MAR [temp2High, tetnp2Low + temp3Low], cl; 
MDR otLow {new list head}, CANCEI.BR [$, 0], LOOPHOLE [wok], LlDisp, c2; 
templLow templLow - chunkLinkQffset, RET [addFreeChunkReturn], c3; 


{ refl 

Increment the reference count of an object. Nil, false, and true have permanently stuck counts, so skip them, Smalllntegers 
don't have reference counts, so skip them too. 

input; otLow Is the object 

otlligh is the high part of the object table base address 
LI is the return link 

there is a pending XDisp to tost for a smalllnteger 


output: 

smash: templLow, temp2H1gh, Q } 


ref 1: 

DISP4 [refiTable, 0C], 
refIDopOl: 

[] falsePointer - otLow, CarryBr, GOTO [doRofl], 
refiOopll: 

[] truePointer - otLow, CarryBr, GOTO [doRefi], 
ref iOoplO: 

[] 1, ZeroBr, GOTO [doRefi], 

rof 1 Small IntegerOO : 

LlDisp, GOTO [returnFromRef1], 


cl; 

c2, at [0D, 10, refiTable]; 

c2, at [OF, 10, rofITable]; 

c2, at [0E, 10, refITable]; 

c2, at [0C, 10, refITable]; 


doRefH: 

BRANCH [$, skipRefi], {skip nil, false, true}, 
tempZHIgh doingNormalRefi, CALL [getOtFlags], 

0 templLow, 

templLow refPlusOneRot8 {for Incrementing ref count), 

[] Q LRotO, XHDIsp {first part of test for stuck ref count}, 

templLow templLow LRot8, BRANCH [$, maybeStuckRef1, 2], 

Q 0 + templLow {up ref count}, {sign is positive, thus not 
stuck and cannot become stuck} 

[] 1, ZeroBr, {force next BRANCH} 


updateOtRef1: 

templLow Q, BRANCH [{CALL} putOtFlags, justGotStuckRef1] 9 


Noop, 

LlDisp, 
returnFromRef 1: 

RET [ref 1 Return], 


c3; 

cl; 

cl, at [doIngNormalRef1, 10, getFlagsReturn]; 

c2; 

c3; 

Cl; 

c2; 
c3; 

cl; 

cl, at [doIngNormalRef1, 10, putFlagsReturn]; 
c2; 

c3; 


maybeStuckRef1: {sign Is negative, can get stuck, may already be stuck} 

00+ templLow {up ref count}, CarryBr {carry Implies already stuck}, c2; 


[] 0 + templLow, CarryBr {carry Implies just got stuck}, 

BRANCH [updateOtRefl, $], c3; 

stuckRefi: 

CANCELBR [$, 1], cl; 

stuckRefIReturn: 

LlDisp, GOTO [returnFromRef1], c2; 

JustGotStuckRef1: {Loom: need to call Loom here for newly stuck ref count} 

Noop, c2; 

Noop, C3; 

CALL [putOtFlags], cl; 

skipRefi: 

GOTO [stuckRefIReturn], cl; 
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{ refd 


Decrement the reference count of an object Nil, false, and true have permanently stuck counts, so skip them. Smalllntegers 
don't have reference counts, so skip them too. 

input: otLow is the object 

otlligh Is the high part of the object table base address 
LI Is the return link 

there is a pending XDisp to test for a small Integer 

output: 

smash: templHigh/Low, temp2H1gh, temp3H1gh/Low, 0. L2 } 

refd: 

temp3Low refM1nusOneRot8, DISP4 [refdTable, 0C], cl; 


refdOopOl: 

[] falsePoInter - otLow, CarryBr, GOTO [doRofd], 


refdOopll: 

[] truePoInter - otLow, CarryBr, GOTO [doRofd], 


refdOoplO: 

[] 1, ZoroDr, GOTO [doRefd], 


c2, at [0D, 10, refdTable]; 

c2, at [OK, 10, refdTablo]; 

c2, at [0E, 10, refdTable]; 


refdSmaI1 IntegorOO: 

LIDisp, GOTO [returnFromRefd]. 


c2, at [0C, 10, refdTable]; 


doRofd: 

temp3Low temp3Low LRot8, 

BRANCH [$, sklpRefd], {skip nil, false, true}, 


gotRefCount: 

temp2High doingNormalRefd, CALL [getOtFlags], 


[] tempiLow LRotO, XHDIsp {first part of stuck ref count test), 
Q ~temp3Low, BRANCH [$, negativeRefCount, 2], 
posItlveRefCount: {not stuck but could go to zero} 

templLow templLow + temp3Low {subtract 1}, CarryBr 

{no carry Implies already zero, an error}, L 2 doIngRefd, 


updateGtRefd: 

BRANCH [IrledToRefdZeroCountObject, $], 

Noop, 

Noop, 

CALL [putOtFlags], 

[] templLow + temp3Low {subtract again}, CarryBr {no carry Implies 
just went to zero}, 

LIDisp, BRANCH [belongsInZct, $], 
retfjrrFromRefd; 

RET [refdReturn], 


c3; 
cl; 

cl, at [doingNormalRefd, 10, getFlagsReturn]; 
c2; 

c3; 

cl; 
c2; 
c3; 

cl; 

cl, at [doingNormalRefd, 10, putFlagsReturn]; 
c2; 

c3; 


negativeRefCount: {could be stuck but cannot go to zero} 

Q Q + 1, {refPlusOneRot8 LRot8} c3; 

[] templLow + 0. CarryBr {carry implies stuck ref count}, cl; 

templLow templLow + temp3Low {subtract one from ref count}, 

BRANCH [$. stuckRefd], C2; 

[] 0, ZeroBr {force BRANCH}, GOTO [updateOtRefd], c3; 


belongsInZct; 

CANCELBR [$, OF], 

CALL [addToZeroCountTable], 

sklpRefd: 

GOTO [refdSmalllntegerOO], 


c3; 

cl; 

cl, at [doingRefd, 10, addToZeroCountTableReturn]; 


stuckRefd: 

GOTO [sklpRefd], 


c3; 


triedToRefdZeroCountObject: 

Q refdZero, CANCELBR [ba11out3, 1], {error} C2; 


{ refd2 

Identical to refd except for return links. } 
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refd2: 

temp3Low refMinus0neRot8, DISP4 [refd2Table, OC], 


cl; 


rerd20op01: 

[] falsePoInter - otLow, CarryBr, GOTO [doRefd2], 
refd20opll: 

[] truePointer - otLow, CarryBr, GOTO [doRofd2], 
ref d20opl0: 

[] 1, ZeroBr, GOTO [doflefdZ], 

rcfd2Smal1IntegerOO: 

LIDisp, GOTO [returnFromRefd2'|, 


c2, at COD. 10, 

c2, at [OF, 10, 

c2, at [OE, 10, 

c2, at [OC, 10, 


ref>2Table]; 

refd2Table]; 

refdZTable]; 

refdZTable]; 


doRefd2: 

temp3Low temp3Low LRotO, 

BRANCH [$, sk1pRefd2], {skip nil, false, true}, 


getRefCount2: 

temp2H1gh doingNormalRefd2, CALL [getOtFlags], 


[] templLow LRotO, XHOisp (first part of stuck ref count test}, 

0 ~temp3Low, BRANCH [$, negativeRefCount2, 2], 
pos itiveRefCount2: {not stuck but could go to zero) 

templLow templLow + temp3Low {subtract 1}, CarryBr 

{no carry implies already zero, an error}, 1.2 doingRofd2, 


updato0tRefd2: 

BRANCH [triedToRefd2ZeroCountObject, $], 

Noop, 

Noop, 

CALL [putOtFlags], 

[] templLow + tomp3Low {subtract again}, Carry8r {no carry implies 
just went to zero}, 

LIDisp, BRANCH [bolongsInZct2, $], 
returnF romRefd2; 

RET [refd2Return}, 


c3; 
cl; 

cl, at [doingNormalRefd2, 10, getFIagsReturn]; 
c2; 

c3; 

cl; 
c2; 
c3; 

cl; 

cl, at [doingNormalRefd2, 10, putFIagsReturn]; 
c2; 

c3; 


negat1veRefCount2: {could be stuck but cannot go to zero} 

Q 0+1, {refPlus0neRot8 LRotB} c3; 

[] templLow + Q, CarryBr {carry implies stuck ref count}, cl; 

templLow templLow + temp3Low {subtract one from ref count}, 

BRANCH [$, stuckRefd2], C 2; 

[] 0, ZoroBr {force BRANCH}, GOTO [updateOtRofd2], c3; 


bo1ongsInZct2: 

CANCELBR [$, OF], 

CALL [addToZeroCountTable], 

skipRefd2: 

GOTO [refd2SmallIntegerOO], 


c3; 

cl; 

cl, at [doingRefd2, 10, addToZeroCountTableReturn]; 


stuekRefd2: 

GOTO [sk1pRefd2], 


c3; 


tr1edToRefd2ZeroCountObject: 

Q refd2Zero, CANCELBR [ba11out3, 1], {error} c2; 


dumrny2: GOTO [ba11out2], 


cl, at [0, 10, refd2Return]; 


{ addToZeroCountTable Loom: Loom may want to get involved here--but I don’t think so 

Add an object to the zero count table. Objects get added to the zero count table when their reference counts go to zero. 
Eventually the zero count table fills up and all the objects in It are recursively freed. In the meantime, we turn on the InZct 
bit in the OT and write the new OT entry. Then we look at the object's old inZct bit and add the object to the zet If it's not 
already there. If this object fills the table, we’ll have to stabilize and free soon. There’s room for some overflow so we can 
finish this bytecode. 

input: otLow Is the object to put Into the zet 

otHigh Is the high part of the object table base address 
L2 is the return link 

output: uTimeToStabilize Is -1 if the zet Is full 
smash: templHIgh/Low, temp2H1gh, temp3High/Low, Q } 
addToZeroCountTable: 

temp3Low inZctRot8, c2; 
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temp3Low temp3Low LRot8, 

temp2High addingToZct, CALL [getOtFlags], 

[] templLow and temp3Low, ZeroBr, 

templLow templLow or temp3Low, LZDisp, BRANCH [al readylnZct, $], 
Q uRumRecordHigh, CANCELBR [$, OF] 

temp 111igh 0 LRotO, CALL [putOtFlags], 

templLow uRumRoco rtlLow, 

Noop, 

Noop, 

MAR [tcmplHIgh. templLow + zctlndexOffset], 

CANCFLBR [$, 0], 

Q MO, {read current index} 

MAR [templHIgh, templLow + zcttov/Offset], 

CANCELBR [$, 0], 

tempBLow MD, {get zct low address} 

MAR [templHIgh, templLow + zctHlghOffset], 
temp3Low temp3Low + Q, CANCELBR [$, 0], 
temp3High MO, {get zct high address} 

{ Note: The Molasses zeroCountTable is one-relative, not 
something in the zct, wo put It in, then bump. } 

MAR [temp3High, temp3Low + 0], 

MDR otLow, {add the object} 

Noop, 

MAR [templHIgh, templLow + zctlndexOffset], 

MDR Q 0+1, CANCELBR [$, 0], LOOPHOLE [wok], {write new index} 
Noop, 

MAR [templHIgh, templLow + stabiHzatioriLimitOffset], 

CANCELBR [$, 0], 

temp3Low MD, (get the zct stabilization limit} 

Noop, 

[] temp3Low - Q, NegBr, 

BRANCH [zctlndexOk, $], {need to stabilize if limit exceeded} 

MAR [templHIgh, templLow + stabilizationFlagOffset], 

MDR needToStabilize, CANCELBR[$, 0], LOOPHOLK[wok], 
uTimeToStab11ize ~stackLow xor stackLow {-1}, 

zctlndexOk: 

Noop, 

L2Disp, 
alreadyInZct: 

RET [addToZeroCountTableRoturn], 


c3; 
cl; 

cl, at [addingToZct, 10, getFlagsReturn]; 
c2; 
c3; 

cl; 

cl, at [addingToZct, 10, putFlagsReturn]; 
c2; 
c3; 

cl; 
c2; 

c3; 

cl; 
c2; 
c3; 

cl; 
c2; 
c3; 

zero-relative. So, while Molasses bumps the index before putting 


cl; 
c2; 
c3; 

cl; 

C2; 

c3; 

cl; 
c2; 
c3; 

cl; 

C2; 

c3; 

cl; 
c2; 
c3; 


cl; 
c2; 

c3; 


{ makeVolatlle 


Input: 


output: 

smash: temp2H1gh/Low, uZctBaseHIgh } 

{upon entry, otLow is the oop to make volatile, uMakeVolatileLInkage Is the return linkage register; if it is odd, each object referred 
to by the object will be refd'd; it it is even, the object is marked volatile, but no refding occurs, smashes temp3Low, 0. LI, L2. 
leaves base of object in uMakeVolatileHigh/Low, and in templHigh/Low. leaves uLastPoInter set up} 

{see If we're trying to make nil volatile -- this happens when the leaf context oop Is nil, check should probably be moved to the place 
where volatilization is done after stabilization...} 

mak(5 Volatile: 

[] otLow xor nllPoInter, ZeroBr, c2; 

BRANCH [$, nllMakeVolatile], c3; 


uMakeVolatileOop otLow, 

LI maklngVolatlle, 

CALL [otMap] {get address of base of object}, 

0 templHIgh {save object base} 
uMakeVolatileHIgh Q, 
uMakeVolatileLow templLow, 


cl; 
c2; 
c3; 

cl, at[mak1ngVolat11e, 10, otMap-return]; 

c2; 

c3; 


templLow templLow + deltaWordOffset, 
Noop, 

Noop, 


cl; 
cZ; 
c3; 


MAR [templHIgh, templLow + 0], 
Noop, 

Q MD {delta word}, 


cl; 
c2; 
c3; 


[] 0 and volatileBIt, ZeroBr {already volatile?}, 


cl; 
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Ybus uMakeVolatileLinkage, XDisp, 

BRANCH [$, doMakeVolatlle, OE], C 2; 

templLow templLow - deltaWordOffset, RET [makeVolatile-return], c3; 


doMakeVolatlle: 

0 0 or volati1eBit, CANCELBR [$, Of], 

MAR [templHigh, templLow + 0], 

MDR Q {delta word with volatile bit set), 

Ybus uMakeVolatileLInkage, XDisp 

{should we refd the referents or not?}, 

templLow tempiLow - deltaWordOffset, 

BRANCH [returnFromMakeVolatile, $, OE], 
templLow templLow + sizeFleldOffset, {refd fields} 

Q templHigh, 

MAR [tomplHigh, templLow + 0], 
templLow templLow - sizeFleldOffset, 
temp3Low MD {size field}, 

temp3Low tcmp3Low + templLow, 

tcmp3Low temp3Low - 1 {low 16 bits of last pointer 
of context object}, 
uLastPointer temp3low, 

{now, sweep the object decrementing reference counts of all pointer 

temp2Low templLow +• f i rstPointerFleldOfObject, 
uZctBaseHigh Q, 
temp2lligh Q LRotO, 

makeVolatileLoop: 

MAR [temp2lligh, temp2Low + 0], LI inMakeVolatile, 

temp2Low temp2 Low + 1, 

otLow MD, XDisp, CALL [refd], 

temp3Low uLastPointer, 

[] temp2Low - temp3Low, ZeroBr, 

temp2High uZctBaseHigh, BRANCH [makeVolati1eLoop, $], 

otLow uMakeVolatileOop, L2 InMakeVolatile, 

Noop, 

Noop, 

CALL [addToZeroCountTable], 

templHigh uMakeVolatl1eHIgh, 
templLow uMakeVolatileLow, 
tempZHigh uZctBaseHigh, 

Noop, 

returnF romMakeVol ati le: 

Ybus uMakeVolatileLinkage, XDisp, 
returningFromMakoVolatile: 

RET [makeVolatlie-return], 


c3; 

cl; 
c2 ; 

c3; 


cl: 
c2; 
c3; 

cl; 
c2; 
c3; 

cl; 

c2; 
c3; 

fields} 

cl; 
c2; 
c3; 


Cl; 
c2; 
c3; 

cl, at [InMakeVolatile, 10, refdReturn]; 

c2; 

c3; 

cl; 
c2; 
c3; 

cl; 

cl, at [InMakeVolatile, 10, addToZoroCountTableReturn]; 
c2; 
c3; 

cl; 

c2; 

c3; 


nilMakeVolatlle: 

GOTO [returnFromMakeVolatile], 


cl; 


{ lastPoInterOf 


Input: 
output: 
smash: Q } 

{upon entry, templHIgh/Low must point at the base of the object of interest, 0 must be the delta word of the object, L2 Is the return 
linkage register, returns the low 16 bits of the ADDRESS of the last pointer In uLastPointer and in temp3Low. smashes 0} 

lastPelnterOf: 

[] 0 and 1 {pointer bit}, ZeroBr, cl; 

Q classCompiledMethodOop, 

BRANCH [doesHavePointers, doesNotHavePoInters], c2; 


{Is pure pointer object -- last pointer Is size of object} 


doesHavePointers: 

templLow templLow + sizeFleldOffset, c3; 

MAR [templHigh, templLow + 0] {start read of length field}, cl; 

templLow templLow - sizeFleldOffset {again point at base of object}, c2; 
temp3Low MD, GOTO [returnFromLastPoInterOf], c3; 


{no pointers, might be compiledMethod -- need to check class} 
doesNotHavePoInters: 
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templLow templLow + classFieldOffset, c3; 

MAR [templHigh, templLow + 0], cl; 
templLow templLow - classFieldOffset {again point at base of object}, c2; 
temp3Low MD {the class of the object}, c3; 

[] temp3Low xor 0 {compiledMethodClass oop}, ZeroBr, cl; 
BRANCH [$, isCompiledMethod], c2; 
temp3Low objectHeaderSize, GOTO [returnFromLastPointerQf], c3; 

{need to got number of literals from the method header} 

IsCompiledMethod: 

templLow templLow *• objectHeaderSize {point at method header}, c3; 

MAR [templlligh, templLow + 0], cl; 
templLow templLow - objectHeaderSize, {again point at base of object} c2; 
temp3Low MD {the method header}, c3; 

temp3Low (RShlftl temp3Low and OFF) {get literal count 

of compiledMethod}, SE 0, cl; 
temp3Low RShlftl temp3Low, SE 0, c2; 
Noop, c3; 

Noop, cl; 
temp3Low temp3Low + literal Start, c2; 
temp3Low temp3Low + objectlloaderSize, c3; 

returnFromLastPoInterOf: 

temp3Low temp3Low - 1, cl; 
temp3Low temp3Low + templLow, L2D1sp, c2; 
uLastPointer temp3Low, RET [lastPoInterOf~return], c3; 


{ stabilize 


input; 
output: 
smash: } 

{Test the memory and oop levels and reset alreadyAlerted if both are above their alert levels. 
((wordLevel >- wordAlertLevel) and: [oopLevel >= oopAlertLevel]) ifTrue: [alreadyAlerted 0]} 
{linkage register Is L0 -- runs only between bytecodes} 


stab 11Ize: 

templHigh uRumRecordHigh, cl; 
templLow uRurnRecordLow, c2; 
ulimeToStabilIze 0, c3; 

testOopLevel; 

MAR [templHigh, templLow + oopLevelLowOffset], cl; 
CANCELBR [$, 0], c2; 
temp3Low MD, c3; 

MAR [templHigh, templLow + oopAlertLevelLowOffset], cl; 
CANCELBR [$, 0], c2; 
0 MD, c3; 

0 temp3Low - Q, CarryBr, cl; 
BRANCH [stabll1ze2, $], c2; 
Noop, c3; 

testWordLevelHIgh: 

MAR [templHigh, templLow ♦ wordLevelHIghOffset], cl; 
CANCELBR [$, 0], C 2; 
temp3Low MD, c3; 

MAR [templHigh, templLow + wordAlertLevelHIghOffset], Cl; 
CANCELBR [$, 0], c2; 
0 MD, c3; 

0 temp3Low - 0, CarryBr, cl; 
[] 0. ZeroBr, BRANCH [stabilize!, $], c2; 
BRANCH [resetAlreadyAlerted, $], c3; 

testWordLevelLow: 

MAR [templHigh, templLow + wordLevelLowOffset], cl; 
CANCELBR [$, O'], c2; 
temp3Low MD, c3; 

MAR [templHigh, templLow + wordAlertLevelLowOffset], cl; 
CANCELBR [$, 0], c2; 
Q MD, c3; 

0 temp3Low - 0. CarryBr, cl; 
BRANCH [stabll1ze3, $], c2; 
Noop, c3; 


MemoryManglement.me 


20-Jan-86 20:46:16 PST 


11 



reset AT readyAlerted: 

MAR [templHigh, templLow + alreadyAlertedOffset], cl; 

MDR 0, CANCELBR [$, 2], LOOPHOLE [wok], c2; 

GOTO [reallyStabi1ize], c3; 

stabl1izel: 

CANCELBR [reallyStabllize, 1], c3 ; 

stabilized: 

GOTO [reallyStabi1ize], c3; 

stabilize3: 

GOTO [real lyStabi'l lze] , c3; 


reallyStabll ize: 

MAR [templHigh, templLow + zctLowOffsot], cl; 
CANCELBR [$, 0], C 2; 
temp2Low MD, {get address of the zct} c3; 

MAR [templHigh, templLow + zctHighOffset], cl; 
uZctBasoLow temp2Low, CANCELBR [$, 0], c2; 
0 temp2High MD, c3; 

uZctBaseHigh 0, cl; 
Noop, c2; 
Noop, c3; 

{get, then smash the zct index from the Ruin record} 

MAR [templHigh, templLow + zctlndexOffset], cl; 
MDR 0, CANCELBR [$, 0], LOOPHOLE [wok], c2; 
temp3Low MD, c3; 

(reset the stabilization flag} 

MAR [templHigh, templLow + stabilizationFlagOffset], cl; 
MDR 0, CANCELBR [$, 0], LOOPHOLE [wok], c2; 
temp3Low temp3Low + temp2Low {yields low 16 bits of one word past 

the last valid oop in the zct}, c3; 


uZctLimit temp3Low, cl; 
uQuoueHead 0, {should be nllPointer} c2; 
uCurrentObject 0, {should be nilPointer} c3; 


{sweep the zct. for each oop marked (in its ot entry) as volatile, reset the isVolatlle bit, and increase the reference counts of all of 
its referents, recall that the zct Index Is one greater than the number of valid entries in the zct} 


stabilizatlontoop: 

[] temp2Low xor uZctLimit, ZeroBr {are we there yet?}, cl; 
temp3Low- OFF, BRANCH [$, countsAreNowCorrect], c2; 
temp3Low temp3Low LRot8, c3; 


MAR [temp2High, temp2Low + 0], cl; 
temp2Low temp2Low + 1, LI stabilizing, c2; 
otLow MD, CALL [otMap2] {so we can get its delta word}, c3; 


templLow templLow + deltaWordOffset, 
temp3Low temp3Low or 0FB {yields FFFB, for turning off 
the IsVolatlle bit}, 

Noop, 


cl, at [stabilizing, 10, otMap2-return]; 


c2; 
c3; 


MAR [templHigh, templLow + 0] {read delta word} cl; 

Noop, c2; 

0 MD, XDisp {to test IsVolatile bit}, c3; 

MAR [templHigh, templLow + 0], BRANCH [oopIsNotVolat 1le, $, 0B], cl; 

0 MDR Q and temp3Low {not volatile anymore!}, 

L2 stabilizIngContext, c2; 

templLow templLow - deltaWordOffset, CALL [lastPointerOf], c3; 


{need to move the tempi regs into temp3 to keep refi from smashing them...} 

0 templHigh, cl, at [stabilizIngContext, 10, 1astPointerOf-return]; 

temp3High Q LRotO, c2; 

temp3Low templLow + classFieldOffset, c3; 

{sweep over the volatile object, upping the reference counts of its referents} 


upRoferents: 

MAR [temp3H1gh, temp3Low + 0], LI correcting, 
Noop, 

OtLow MD, XDisp, CALL [refi]. 


cl; 
c2; 
C3; 


[] temp3Low xor uLastPointer, ZeroBr, 

temp3Low temp3Low + 1, BRANCH [$, thisOnelsStable], 

GOTO [upReferents], 


Cl, at [correcting, 10, reflReturn]; 

c2; 

c3; 


oopXsNotVolatile: 

Noop, c2; 

thisiOnelsStable: 

temp2H1gh uZctBaseHigh, GOTO [stabilIzationLoop], c3; 


{at this point, all contexts have been stabilized, and all reference counts are correct, sweep over the zct again: any object in the zct 
whosie reference count Is zero is garbage!) 
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{temp2High is still valid despite the CALLS, restore temp2Low> 


counts A reNowCorrect: 

temp2Low uZctBaseLow, 


c3; 


sweepAndDoal locatel.oop: 

[] temp2Low xor uZctLirait, ZeroBr {are we there yet?}, cl; 
temp2H1gh uZctBaselligh, BRANCH [$, returnFromStabi1Ize], c2; 
temp3Low InZctRotS, c3; 

MAR [temp2H1gh, temp2Low * 0] (get oop from zct} cl; 
temp3Low ~tcmp3Low LRot8, c2; 
otLow MD, c3; 


temp2High deallocating, CALL [gctOtFlags], 

templLow templLow and temp3Low {clear inZct}, CALL [pu 

temp3Low refCountRot8, 
temp3Low temp3Low LRot8, 

Noop, 

Noop, 

□ templLow and teinp3Low, ZeroBr, 

tomp2Low teinpZLow + 1, BRANCH [swoepAndDeallocateLoop, 

needToDeallocate: 

{save our current state} 

Q temp2High, 

uZctSwoepHigh Q, L3 fromStabi11ze, 
uZctSweepLow temp2Low, CALL [deallocate], 

{recover our state} 
temp2Migh uZctSwcepHigh, 
temp2Low uZctSweepLow, 

GOTO [sv/ecpAndDcal locateLoop], 


cl; 

Flags], cl, at [deallocating, 10, getFlagsReturn]; 

cl, at [deallocating, 10, putFlagsReturn]; 

c2; 

c3; 

cl; 
c2; 

, c3; 


cl; 
c2; 
C3; 


cl, at [fromStabi1ize, 10, deallocate-return]; 

c2; 

c3; 


returnFromStab I1ize: 

Noop, c3; 

Noop, cl; 

LOOisp, c2; 

RET [stabi1ize-return], c3; 


{ deallocate 


Input: otLow is the object to deallocate 
L3 is the return link 


output: 

smash: Q, uClass, LI, L2 } 

{otLow is the oop to deallocate — It has already been determined that 
its reference count Is 0. L3 is the return linkage register} 
dea(locate: 

L.2 startingDeallocate, 

Noop, 

[] otLow LRotO, XDIsp, CALL [getClass], 

templLow templLow + deltaWordOffset, 

0 cl assCompiledMethodOop, 

[] temp3Low xor 0, ZeroBr, 

{get delta word to see if object has pointers} 

MAR [templHigh, templLow + 0], 

BRANCH [$, deallocatingACompiledMethod], 

Noop, 

Q MD, XLDisp, 

BRANCH [deallocateWIthNoPointers, deallocateWithPointers, 2], 


cl; 
c2; 
c3; 

cl, at [startingDeallocate, 10, getClass-return]; 

c2; 

c3; 


cl; 
c2; 
c3; 

Cl; 


deallocateWIthNoPointers: 

templLow templLow - deltaWordOffset, LI freeNonPointerObject, c2; 

uClass temp3Low, CALL [adjustLevelsAndReturnToPool], c3; 


temp3Low uClass, GOTO [nowDoObjectsClass], 


cl, at [freeNonPointerObject, 10, addFreeChunkReturn]; 


deallocatlngACompiledMethod: 

GOTO [deallocateWithPointersA], c2; 


deallocateWithPointers: 

Noop, c2; 

deallocateWithPointersA: 

templLow templLow + offsetFromDeltaWordToClassField, c3; 
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{enqueue this object for deallocation) 

MAR [tempJHigh, templLow + 0], Cl; 

MDR uQueueHead, c2; 

uQueueHead otLow, c 3; 

Moop, cl- 

nowDoObjectsClass: 

Moop, C 2; 

otLow temp3Low LRotO, XDisp, GOTO [special Refd], c3; 


{if there is a current object, continue with it. if not, if there is 
a queued object, start it. otherwise we are done} 


otl.ow uCurrentObject, ZeroBr, 

BRANCH [continueWithCurrentObject, $], 
otLow uQueueHead, ZeroBr, 


cl, at [nowDoneWithObjcct, 10, addFrceChunkReturn]; 

c2; 

c3; 


BRANCH [startWIthQueuellead, $], cl; 
L3D1sp, c 2; 
RET [deal 1ocate-return}, {all recursive freeing Is now complete} c3; 


startWithQueueHead: 

uCurrentObject otLow, LI sweepingObject, c2; 

CALL [otMap2], C 3 ; 


templLow templLow + deltaWordOffset, 
Q templHigh, 
uSoFarlligh Q, 


cl, at [sweepingObject, 10, otMap2-returnj; 
c2; 
c3; 


MAR [templHigh, templLow +0], cl; 
templLow templLow - deltaWordOffset, L2 getObjectEndForFreeing, c2; 
Q MD, XDisp, {tost pointers bit) c3; 

BRANCH [doingACompiledMethod, notDoingACompiledMethod, 0E), cl; 


{both isCompiledMethod and doesHavePointers live 
do i ng AComp i ledMotliod; 

CALL [isCompiledMethod], 


in the 1astPolnterOf routine) 
c2; 


notDoingACompiledMethod: 

CALL [doesHavePointers], c2; 

uCurrentObjectBaseLow templLow, cl, at [getObjectEndForFreeing, 10, 

lastPoInterOf-return]; 

templLow templLow + classFieldOffset, c2; 

Noop, c3; 


MAR [templHigh, templLow + 0], cl; 
Noop, C 2; 
temp2Low MD {link to next object on queue), c3; 


uQueueHead temp2Low, 
Noop, 

GOTO [areWeThereYet], 


cl; 
c2; 
c3; 


doAnotherFleld: 

MAR [templHigh, templLow + 0], 

Noop, 

otLow MD, XDisp, GOTO [specialRefd], 


cl; 
c2; 
c3; 


continueWithCurrentObject: 

templLow uSoFar, c3; 

templHigh uSoFarHigh, cl; 

temp3Low uLastPoInter, c2; 

Noop, c3; 

areVfeThereYet: 

[] templLow xor temp3Low, ZeroBr, cl; 

templLow templLow + 1, BRANCH [$, doneWIthObject], c2; 

uSoFar templLow, GOTO [doAnotherFleld], c3; 


doneWIthObject: 

Noop, c3; 

otLow uCurrentObject, cl; 

templLow uCurrentObjectBaseLow, LI nowDoneWithObject, c2; 

uCurrentObject 0 {should be nllPoInter), 

CALL [adjustLevelsAndReturnToPool], c3; 


{ speclalRefd 
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Decrement the reference count of an object. Nil, false, and true have permanently stuck counts, so skip them. Smalllnteqers 
don't have reference counts, so skip them too. 

input: otLow Is tho object 

otlllgh Is the high part of tho object table base address 
there Is a pending XDIsp to test for a smalllntager 


output: 

smash: templHigh/Low, tempZHIgh, to«ip3H1yh/Low, Q, L2 } 

specialRefd: 

temp3Low refM1nusOneRot8, DXSP4 [speclalRofdTable, OC], cl: 


speclialRefdOopOl: 

[] falsePolnter - otLow, CarryBr GOTO [speclalDoRefdj, 


c2, at [OD, 10, specialRefdfable]; 


specialRefdOopll: 

[] truePointer - otLow, CarryBr, GOTO [spec ialOoRofd], c2, at [OF, 10, special RefdTable]; 

specialRefdOoplO: 

(.1 !. ZeroBr, GOTO [specialDoRefd], c2, at [Of., 10, specialRefdTabloj; 


special RefdSinal 1 IntegerOO: 

GOTO [specialStuckRefd], 


c2, at [OC, 10, special RefdTable]; 


spocialDoRefd: 

temp3Low temp3Low LRot8, 

BRANCH [$, skipSpecialRefd], (skip nil, falsa, true} c3; 

getSpecialRefCount: 

t.einp2High doingSpecial Refd, CALL [getOtFIags], cl; 


[] templLow LRotO, XHDisp {first part of stuck ref count test}, cl, at [doingSpeciaI Refd, 10, getFlagsReturnl; 

0 ~tomp3Low, BRANCH [$, negativeSpocialRefCount, 2], c2 ; 

positIveSpecialRefCount: {not stuck but could go to zero} 

templLow templLow + temp3Low {subtract 1}, CarryBr {no carry Implies 

already zero, an error}, c3; 

UpdateOtSpecialRefd: 

BRANCH [trledToSpeclalRefdZeroCountObject, $], cl; 

Noop, c2; 

Noop, c3; 


CALL [putOtFlags], 

[] templLow + temp3Low {subtract again}, CarryBr {no carry Implies 
just went to zero}, 

templLow templLow LRot8, BRANCH [specialNeedsDeallocation, $], 

GOTO [more]. 


cl; 


cl, at [dolugSpecialRefd, 10, putFlagsReturn]; 

c2; 

c3; 


negativeSpecialRefCount: {could be stuck but cannot go to zero} 


0 0+1, {rofPlus0neRot8 LRot8} c3; 

[] templLow + 0. CarryBr {carry Implies stuck ref count}, cl; 

templLow templLow + temp3Low {subtract one from ref count}, 

BRANCH [$, specialStuckRefd], c2; 

[] 0, ZeroBr {force BRANCH}, GOTO [updateOtSpecialRefd], c3; 


specialNeedsDeallocation: {ref count just went to zero} 

[] templLow and 1nZctRot8, ZeroBr, c3; 

BRANCH [speclalAlreadylnZct, $], {deallocate now If not In zet} cl; 

Noop, c2; 

GOTO [deallocate], c3; 

speclalAlreadylnZct: 

Noop, c2; 

specialStuckRefd: 

GOTO [more], C 3 ; 


skipSpecialRefd: 

GOTO [speclalAlreadylnZct], 


cl; 


triedToSpecialRefdZeroCountObject: 

Q specialRefdZero, GOTO [bailout3], {error} 


c2; 


adjustLevelsAndReturnToPool: 

templLow templLow + sizeFieldOffset, cl; 

temp2H1gh uRumRecordHIgh, c2; 

temp2Low uRumRecordLow, c3; 

IncrementOopLevel: 

MAR [temp2H1gh, temp2Low + oopLevelLowOffset], cl; 
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CANCELBft [$, 0], C 2; 

temp3Low MD, c3; 

MAR [temp2High, temp2l.ow + oopLevel l.owOf f set] , cl; 

MDR temp3Low tempSLow + 1, 

CANCELBR [$, 0], LOOPHOLE [wok], CarryBr, c2; 

BRANCH [IncreaseWordLevelLow, ImpossibleOopLevel], c3; 

imposs ibloOopLevel: 

0 tooManyOops, GOTO [bailout?], cl; 

IncreasoWordLovelLow: 

MAR [templHigh, templLow + 0], cl; 

templLow templLow - sizeFleldOffset, c2; 

teinp3Low Mf), c3; 

MAR [temp2High, temp2Low + wordLevelLowOffset], cl; 

CANCELBR [$, 0], C 2- 

Q MO, c3; 

MAR [temp2H1gh, temp2Low + wordLevelLowOffset], cl; 

MDR 0 + temp3Low, CANCELBR [$, 0], LOOPHOLE [wok], CarryBr, c2; 

DRANCH [returnToPool, wordLevolCarry], c3; 


wo rdLevelCarry: 

MAR [tomp2H1gh, temp2Low + wordl.eve IlllghOf f set], cl- 

CANCELBR [$, 2], ' c 2; 

temp3Low MD, c3; 

MAR [ temp2IHgh, tempZLow + wordLevelllighOf f set], cl; 

MDR tempOLow tomp3Low + 1, CANCELBR [$, O], LOOPHOLE [wok], c2; 

Noop, ' c3; 


returnToPool; 

{build a mask to set all ref count bits on and to set purpose bits to free (11)} 


temp3Low refCountRot8, cl; 

temp3Low temp3Low LRot8, c2; 

temp3Low temp3Low or freeOop, c3; 

ten»p2H1gh returnIngToPool, temp2Low templLow, CALL [getOtflags], cl; 


templLow templLow or temp3Low, CALL [putOtFlags], cl, at [returningToPool, 10, getFlagsReturn]; 

{upon entry, otLow Is the oop of the object to add to the free list, 

templHigh/temp2Low must be that object's base, calls addToFreeChunkList 
thus smashing teinp2High/Low and 0- smashes temp3Low} 


addToProperF reoChunkLIst: 

templLow temp2Low + sizeFieldOffset 
0 1argestFreeChunkSizo, 

Noop, 


cl, at [returningToPool, 10, putFlagsReturn]; 
c2; 
c3; 


MAR [templHigh, templLow + 0], cl; 
tomplLow tempi Low - sizeFieldOffset, c2; 
temp3Low MD {object's size}, c3; 


[] temp3Low - 0, CarryBr, cl; 

BRANCH [selectRegularLIst, selectBigFreeList], c2; 


selectRegularLIst: 

GOTO [addToFreeChunkLIst], 


c3; 


selectBigFreeList: 

temp3Low Q, GOTO [addToFreeChunkLIst], 


c3; 


{ Edit history: 

13-Jan-86 16:47:16 Trow.pa 

30-Sep-85 17:21:46 Trow.pa 


tighten InitialIzeObjectBody loop 
convert to stretch format } 
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{ CombflC.mc 

Combination rule subroutines for bitblt primitive for Rum, the Dandelion Smalltalk - 80 microcoded virtual machine, 
by T Tokunaga, J Trow 
19 - Jan - 86 18:07:13 

Copyright 1985,1986 by Xerox Corporation. All rights reserved. } 


MAR_[destAddrHigh, destAddrLow + G], GOTO [combOEOOl], 


cl, at (0,10, combQCI; 


MAR_[destAddrHigh, destAddrLow +• 0], GOTO (comb0E0Fl|, 


' cl, at [OF, 10, combOCJ; 


^******************************* combi nation Rule = 1 ************* 

{ — sourceWord bitAnd: destinationWord-> 

combOCOI: 

MAR _ [sourceAddrHigh, sourceAddrLow + 0|, CALL [getSource], 


******* 




cl, at (01,10, combOC!; 


{ - 

{subroutine : getSource > 
getSource: 

uBBTTemp_sourcelndex and ~otLow, L3Disp, 

temp2Low_MD and temp2Low, RET [getSource - return], 

{- 


> 


c2; { mergeMask bitlnvert bitAnd: dest8itsat:destlndex +■ 1> 
c3;{ sourceWord __skewWord bitAnd: HalftoneWord } 
-> 


sourceindex_sourcelndex and temp2Low, 

sourceWord and destinationWord } 

otLow __ sourcelndex and otLow, CALL (store 1], 


cl, at [01,10, getSource-return); { mergeWord 
c2; { mergeMask bitAnd: mergeWord } 


{Subroutine: store 1} 
store 1: 

temp2low_ otLow or uBBTTemp, c3; 

MAR_[destAddrHigh,destAddrLow 0], cl; 

MDR _ temp2low, temp3Low _ temp3Low + 0, ZeroBr, c2; 

sourceAddrLow_sourceAddrLow + Q, 

BRANCH [contCombOC01, finishedCombOC01], c3; 

contCombOCOI: 

temp2Low_uHalftoneWord, L3Disp, cl; 

temp3Low _ temp3Low - 1, ZeroBr, RET [store 1 - return], c2; 


finishedCombOCOl: 

destAddrLow __ destAddrLow + Q, GOTO [finishedCombOEOO], 
{- 


cl; 

-- } 


destAddrLow_destAddrLow + Q, 

BRANCH [noLastCombOCOI, yesLastCombOC011, 


c3,at [01,10, store 1 - return]; 


noLastCombOCOI: 

MAR_[sourceAddrHigh, sourceAddrLow + 0], CALL (getSource 1], 


{-- 

getSource 1: 

sourceAddrLow_sourceAddrLow +• Q, 

sourcelndex _ MD and temp2Low, L3Disp, 


---> 

c2; 

c3; { sourceWord __skewWord bitAnd: HalftoneWord > 


MAR_[destAddrHigh, destAddrLow + 0], RET [getSource 1 - return), 

{--- 


cl; 

- > 


Noop, c2, at [01,10, getSourcel - return]; 

sourcelndex _ MD and sourceindex, CALL [store], c3; { mergeWord _ sourceWord and destinationWord } 
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{- 

{subroutine : store } 
store; 

MAR_[destAddrHigh, destAddrLow + 0], l_3Disp, cl; 

MDR _ sourcelndex, temp3Low ___ temp3Low - 1, ZeroBr, RET [store - return], c2; 

{- 


> 


> 


destAddrLow _ destAddrLow + Q, 

BRANCH [noLastCombOC011, yesLastCombOC0111, c3, at [01, 10, store - return]; 

noLastCombOC011; 

MAR _ [sourceAddrHigh, sourceAddrLow + 0], CALL [getSourcel], cl; 


yesLastCombOCO11: 

MAR_ [destAddrHigh, destAddrLow + 0], cl; 

yesLastCombQCQ12: 

otLow_uMask2, c 2; 

sourcelndex __ MD, GOTO (combOCOI], c3; 


yesLastCombOCOI: 

MAR_(destAddrHigh, destAddrLow + 0], GOTO (yesLastCombOCOI2], 


cl; 


£******************************* combinationRule — 2 **************** 

{-- sourceWord bitAnd; destinationWord bitlnvert-> 

comb0C02: 

MAR_[sourceAddrHigh, sourceAddrlow + 0], CALL (getSourcej, 


>**********■. 


*} 


cl, at [02, 10, combOC]; 


temp2Low _ temp2Low and —sourcelndex, 

and destinationWord bitlnvert > 

otLow _ temp2Low and otLow, CALL [store 1], 

destAddrLow _ destAddrLow +■ Q, 

BRANCH [noLastComb0C02, yesLastComb0C02], 


cl, at (02, 10, getSource-return];{mergeWord_sourceWord 
c2; { mergeMask bitAnd: mergeWord > 

c3, at [02,10, storel - return]; { restore haiftoneWord } 


noLastComb0C02: 

MAR_ [sourceAddrHigh, sourceAddrLow + 0], CALL [getSourcel], 


cl; 


NOOp, 

sourcelndex __ ~MD and sourcelndex, CALL [store]. 


c2, at [02,10, getSourcel - return]; 

c3; { sourceWord bitAnd: destination bitlnvert } 


destAddrLow _ destAddrLow + Q, 

BRANCH (noLastComb0C021, yesLastComb0C021 ], 


c3, at [02,10, store - return]; 


noLastComb0C021: 

MAR_ [destAddrHigh, destAddrLow + 0], CALL [getSourcel], 


yesLastComb0C021: 

MAR_[destAddrHigh,destAddrLow r 0], cl; 

yesLastCombOCQ22: 

otLow_uMask2, c2; 

sourcelndex _ MD, GOTO [comb0C02], c3; 


yesLastComb0C02; 

MAR _ [destAddrHigh, destAddrLow + 0j, GOTO [yesLastComb0C022], 


cl; 


^******************************* combinationRule = 3 ************* 

{-- sourceWord-> 

comb0G03: 

MAR _ [sourceAddrHigh, sourceAddrLow + 0], CALL [getSource], 


*> 


cl, at [03,10, combOC]; 


otLow_temp2Low and otLow, cl, at [03, 10, getSource - return]; { mergeMask bitAnd: 

mergeWord } 

CALL [storel], c2; 


destAddrLow __ destAddrLow + Q, 

BRANCH [noLastComb0C03, yesLastComb0C03], 


c3, at [03,10, storel - return]; 


noLastComb0C03: 

MAR _ [sourceAddrHigh, sourceAddrLow + 0], 
noLastComb0C032: 

sourceAddrLow _sourceAddrLow + Q, 
sourcelndex __ MD and temp2Low, CALL [store]. 


cl; 

c2; 

c3; { skew Word bitAnd: HaiftoneWord } 
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destAddrLow_destAddrLow + Q, 

BRANCH [noLastComb0C031, yesLastComb0C031 ], 


c3, at [03,10, store - return]; 


noUi$t(;ombQC031: 

MAR _ [sourceAddrHigh, sourceAddrLow + 0], GOTO [noLastComb0C032], cl; 

yesLastCombOCQ31: 

MAR_[destAddrHigh, destAddrLow * 0], cl; 

yesLastComb0C032: 

otLow u M ask2, c2; 

sourcelndex MD, GOTO [combOCQ3], c3; 


yesLastComb0C03: 

MAR __ [destAddrHigh, destAddrlow + 0|, GOTO [yesLastComb0C032], 


cl; {***** joku *****} 


{******************************* combinationRule = 4 ************* 

{-sourceWord bitlnvert bitAnd; destinationWord-} 

comb0C04: 

MAR _ [sourceAddrHigh, sourceAddrlow + 0], CALL [getSource], 




cl, at [04.10, combOCl; 


sourcelndex _ -temp2low and sourcelndex, 

bitlnvert bitAnd:destinationWord} 

otLow_sourcelndex and otLow, CALL [storel ], 

destAddrLow_destAddrlow + Q, 

BRANCH [nolastComb0C04, yesLastComb0C04], 


cl, at [04,10, getSource - return];{mergeWrod_sourceWord 

c2; 

c3, at [04, 10, storel - return]; 


noLastComb0C04: 

MAR _ [sourceAddrHigh, sourceAddrLow + 0], CALL [getSource 1], 


cl; 


sourcelndex __ -sourcelndex, 
bitlnvert} 

sourcelndex _ MD and sourcelndex, CALL [store]. 


c2,at [04,10,getSourcel -return|; { sourceWord 
c3; { get DestinationWord and merging } 


destAddrLow_destAddrLOw + Q, 

BRANCH [noLastComb0C04l,yesLastComb0C04l], 


c3, at [04, 10, store - return]; 


noLcistCombQC041: 

MAR_[sourceAddrHigh, sourceAddrlow + 0], CALL [getSourcel], cl; 

yesLastComb0C04: 

MAR __ [destAddrHigh, destAddrLow + 0], cl; 

yesLastComb0C042: 

otLow_uMa$k2, c2; 

sourcelndex_MD, GOTO [comb0C04], c3; 

yesLastComb0C041: 

MAR _ [destAddrHigh, destAddrLow + 0], GOTO [yesLastComb0C042], cl; 


^******************************* combinationRu l e 

combOCOS: 

GOTO [allFinished], 


**************************•*******!, 


cl, at [05, 10, combOC]; 


{A****************************** combinationRule = 6 ************* 

{-- sourceWord bitxor: destinationWord-} 

comb0C06: 

MAR _ [sourceAddrHigh, sourceAddrLow + 0], CALL [getSource], 


■****} 


cl, at [06, 10, combOC]; 


sourcelndex_sourcelndex xortemp2Low, c1,at{06,10,getSource-return]; 

otLow _sourcelndex and otLow, CALL [storel], c2; { masking > 


destAddrLow ___destAddrLow + Q, 

BRANCH [noLastComb0C06, yeslastComb0C06], 


c3, at (06,10, storel - return]; 


noLastComb0C06: 

MAR _ [sourceAddrHigh, sourceAddrLow + 0], CALL [getSourcel], 


Noop, 

sourcelndex _ MD xor sourcelndex, CALL [store]. 


c2, at [06, 10, getSourcel - return]; 
c3; { get destinationWord and merging } 


destAddrLow _destAddrLow + Q, 

BRANCH [noLastComb0C06l, yesLastComb0C06 1 ], 


c3, at [06, 10, store - return]; 


noLa$tCombOCQ61: 

MAR__ [sourceAddrHigh, sourceAddrLow + 0], CALL [getSourcel], 
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yesl.a$tComb0C061: 

MAR _ [destAddrHigh, destAddrLow + Oh cl; 

yesL.astComb0C062: 

otLow __ uMask2, c2; 

sourcelndex _MD, GOTO [comb0C06], c3; 

yesl.astComb0C06: 

MAR_[destAddrHigh, destAddrLow + 0], GOTO [yesLastCombOCD62], cl; 


{******************************* com binationRule = 7 ***************************** 

{-- sourceword bitOr: destlnationWord-} 

comb0C07: 

MAR_[sourceAddrHigh, sourceAddrlow + 0], CALL [getSource], 


:****-J, 


cl, at [07,10, combOC]; 


sourcelndex _temp2Low or sourcelndex, 

sourceWord or destination Word } 

otLow_sourcelndex and otLow, CALL (store 1], 


cl, at [07,10, getSource - return!; { mergeWord 
c2; 


destAddrLow _ destAddrLow + Q, 

BRANCH [noLastComb0C07, yesLastCombQC07h 


c3, at (07,10, storel - return); 


noLastComb0C07: 

MAR_(sourceAddrHigh, sourceAddrLow + 01, CALL (getSource 1), 


cl; 


Noop, 

sourcelndex_MD or sourcelndex, CALL [store], 


c2, at (07,10, getSource 1 - return]; 
c3; { SWord or DWord } 


destAddrLow_destAddrLow + Q, 

BRANCH [noLastComb0C071, yesLastComb0C071|, 


c3, at (07,10, store - return]; 


noLastComb0CQ71: 

MAR_(sourceAddrHigh, sourceAddrLow + 0], CALL [getSource 1], 


cl; 


yesLastComb0C071; 

MAR_[destAddrHigh, destAddrLow + 0], cl; 

ye$LastComb0C072: 

otLow _ uMask2, c 2; 

sourcelndex_MD, GOTO [comb0C07], c3; 


yeslastCombOCO 7: 

MAR_[destAddrHigh, destAddrLow + 0], GOTO [yesLastComb0C072], 


cl; 


^*** 1 ?*'***'**********'************** combinationRule — 8 *********************************^- 

{-- sourceWord bitlnvert bitAnd; destlnationWord bitlnvert-> 

comb0C08: 

MAR_[sourceAddrHigh, sourceAddrLow + 0], CALL [getSource], cl, at (08,10, combOCl; 


temp2Low_-temp2Low, 

> 

temp2Low_-sourcelndex and temp2Low, 

otLow _ temp2Low and otLow, 


cl, at [08,10, getSource-return]; { sourceword bitlnvert 

c2; { merging } 
c3; 


Noop, cl; 

CALL [storel], c2; 


destAddrLow_destAddrLow + Q, 

8RANCH [noLastComb0C08, yesLastComb0C08], 


c3, at [08, 10, storel - return); 


noLastComb0C08: 

MAR_{sourceAddrHigh, sourceAddrLow + 0], CALL [getSourcell, 


sourcelndex _ -sourcelndex, 

sourcelndex __ -MD and sourcelndex, CALL [store]. 


c2, at [08,10, getSource 1 - return); 

c3; { -sourceword and -destinationWord } 


destAddrLow __ destAddrLow + Q, 

BRANCH [noLastComb0C081, yesLastCombOCOSI}, 


c3, at [08,10, store - return); 


noLastCombOCOSI: 

MAR_ [destAddrHigh, destAddrLow + Oh CALL [getSourcel], 


cl; 


yeslastComb0C081: 

MAR_ [destAddrHigh, destAddrLow + Oh cl; 

yesLastComb0C082: 

otLow _ uMask2, c2; 

sourcelndex_MD, GOTO [comb0C081, c3; 


ye$LastComb0C08: 

MAR_[destAddrHigh, destAddrLow + Oh GOTO [yesLastComb0C082], 
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£******************************* cQmbinationRuls * 9 *********************************j 

{-- sourceWord bitlnvert bltXor: destinatioWord-} 

combO CO 9: 

MAR_[sourceAddrHigh, sourceAddrLow + 0], CALL [getSource], 

cl, at [09,10, combOC]; 


sourceindex __ -temp2Low xor sourceindex, 
otLow _ sourceindex and otLow, CALL [store 1], 

cl, at [09,10, getSource-return}; { merging} 

c2; 


destAddrLow _ destAddrLow + Q, 

BRANCH [noLastComb0C09, yeslastComb0C09], 

c3, at [09,10, storel - return]; 


noLastComb0C09: 

MAR _ [sourceAddrHigh, sourceAddrLow + 01, CALL [getSource 1], 

cl; 


sourceindex __ ^sourceindex, 

sourceindex _ MD xor sourceindex, CALL [store]. 

c2, at [09,10, getSourcel ~ return]; 

c3; { sourceWord bitlnvert bitXor: destinationWord } 


destAddrLow _destAddrLow + Q, 

BRANCH [noLastCombQC091, yesLastComb0C091], 

c3, at (09,10, store - return]; 


noLastComb0C091: 

MAR _ [sourceAddrHigh, sourceAddrLow + 0], CALL (getSourceil. 

cl; 


yesLastComb0C091: 

MAR _ [destAddrHigh. destAddrLow + 0], 
yesLastComb0C092: 

otLow_uMask2, 

sourceindex _ MD, GOTO [comb0C09], 

cl; 

c2; 

c3; 


vesLastComb0C09: 

MAR _ [destAddrHigh, destAddrLow + 01, GOTO (yesLastComb0C092l, 

cl; 


^******************************* — Qy[^ ******************************* **J 

{-destinationWord bitlnvert-} 

combOCOA: 

MAR _ [destAddrHigh, destAddrLow + 0], 

{ put: {(mergeMask bitAnd: mergeWord) bitOr:(mergeMaks bitrinvert bitAnd: (destBits at; destlndex = 
mdr _ sourceindex xor otLow, 

[] _ temp3Low, ZeroBr, 

cl, at (0A, 10, combOC]; 

D)} 

c2; 

c3; 


destAddrLow_destAddrLow +• Q, BRANCH [contCombOCOA, finishedCombOCOA], 

cl; 


cont CombOCOA: 

temp3Low __ temp3Low - 1, ZeroBr, 

temp2Low_uHaiftoneWord, BRANCH [noLastCombOCOA, yeslastCombOCOA], 

c2; 

c3; 


noLastCombOCO A: 

MAR _ [destAddrHigh, destAddrLow + 0], 
noLastComb0C0A2: 

Noop, 

sourceindex __ ~MD, CALL [store]. 

cl; 

c2; 

c3; { get ^-destinationWord } 


destAddrLow _ destAddrLow + Q, 

BRANCH [noLastCombOCOA 1, yesLastCombOCOAl], 

c3, at [0A, 10, store - return]; 


noLastCombOCOA 1: 

MAR_[destAddrHigh, destAddrLow + 0], GOTO [noLastComb0C0A2], 

cl; 


yesLastCombOCOA 1: 

MAR_[destAddrHigh, destAddrLow + 0], 

yesLastCombOCOA2: 

OtLow_uMask2, 

sourceindex _ MD, GOTO [combOCOA], 

cl; 

c2; 

c3; 


yesLastCombOCOA: 

MAR_[destAddrHigh, destAddrLow + 0], GOTO (ye$LastComb0C0A2j, 

cl; 


finishedCombOCOA: 

temp3LOw_uH, GOTO [finishedCombOEOOl], 

c2; 


^*** *************** ************* com binationRule = 0B *********************************} 

{ --sourceWord bitOr: destinationWord bitlnvert-} 

combOCOB: 

MAR_[sourceAddrHigh, sourceAddrLow + 0], CALL (getSource), 

cl, at [0B, 10, combOC]; 


sourceindex_~temp2Low and sourceindex, 

cl, at [0B, 10, getSource - return]; { merging } 
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otLow _ -sourceindex and otLow, 


CALL [store 1), 


destAddrLow_destAddrLow + Q, 

BRANCH [noLastCombOCOB, yesLastCombOCOB], 


c3, at (OB, 10, storel - return]; 


noLastCombOCOB: 

MAR _ [sourceAddrHigh, sourceAddrLow + 0], CALL [getSourcel], 

sourceindex _ -sourceindex, 
sourcelndex _ MD and sourceindex, 

MAR _ [destAddrHigh, destAddrLow +• 0], 

MDR_-sourceindex, 

destAddrLow _ destAddrLow + Q, 


cl; 

c2, at [OB, 10, getSourcel - return]; 
c3; 

cl; 

c2; 

c3;{ sourceWord bitinvert bitOr: destination Word } 


Noop, 

temp3Low_temp3Low - 1,ZeroBr, 

BRANCH [noLastCombOCOB 1, yesLastCombOCOB 1], 


cl; 

c2; 

c3; 


noLastCombOCOB 1: 

MAR _ (sourceAddrHigh, sourceAddrLow + 01, CALL [getSourcel], 


yesLastCombOCOB 1: 

MAR_[destAddrHigh, destAddrLow + 0], 

yesLastComb0C0B2: 

otLow_uMask2, 

sourceindex _ MD, GOTO [combOCOB], 


c2; 

c3; 


yesLastCombOCOB: 

MAR_[destAddrHigh, destAddrLow + 0], GOTO [yesLastComb0C0B2], 


{***■***********«*******+******** combinationRuie = 0C ************^ 

{ — — sourceWord bitinvert-} 

combOCQC: 

MAR _ (sourceAddrHigh, sourceAddrLow +• 0], CALL [getSource], 


} 


cl, at [0C, 10, combOCl; 


otLow _ - tern p2 Low and otLow, 

CALL (storel], 

destAddrLow_destAddrLow + Q, 

BRANCH [noLastCombOCOC, yesLastCombOCOC], 


cl, at (0C, 10, getSource - return]; 
c2; 

c3, at [0C, 10, storel - return]; 


noLastCombOCOC: 

MAR_[sourceAddrHigh, sourceAddrLow + 0], CALL [getSourcel], 

noLastComb0C0C2: 

sourceindex _ -sourceindex, 

CALL [store]. 


cl; 

c2, at (0C, 10, getSourcel - return]; 
c3; 


destAddrLow _ destAddrLow + Q, 

BRANCH [noLastCombOCOC 1,yesLastComb0C0C1], 


c3, at (0C, 10, store-return]; 


noLastCombOCOC 1: 

MAR_[sourceAddrHigh, sourceAddrLow •+• 0], CALL [getSourcel], cl; 

yesLastCombOCOCI: 

MAR _ [destAddrHigh, destAddrLow + 0], cl; 

yesLast€ombOCOC2: 

otLow __ uMask2, c2; 

sourceindex_MD, GOTO [combOCOC], c3; 


yesLastCombOCOC: 

MAR_[destAddrHigh, destAddrLow +• 0], GOTO [yesLastCombOCOC2], 


cl; 


I'***'******#**#** **************** combinationRuie — OD *****'************ ,lt **** i, '*** ilt ******j 

{-sourceWord bitinvert bitOr: destnationWord-} 

combOCOD: 

MAR_[sourceAddrHigh, sourceAddrLow + 0], CALL [getSource], c1,at(0D, 10, combOC]; 


temp2Low_temp2Low and -sourceindex, 

otLow__ ~temp2Low and otLow, CALL [storel], 
destAddrLow _ destAddrLow + Q, 

BRANCH [noLastCombOCOD, yesLastCombOCOD], 


cl, at [0D, 10, getSource - return]; { merging } 

c 2; 

c3, at [0D, 10, storel - return]; 


noLastCombOCOD: 

MAR _ [sourceAddrHigh, sourceAddrLow + 0], CALL [getSourcel], 
sourceindex __ -sourceindex, 
bitinvert} 

sourceindex _ MD or sourceindex, CALL, [store]. 


cl; 

c2, at [0D, 10, getSourcel - return]; { sourceWord 
c3; { -SWord or DWord } 


destAddrLow _ destAddrLow + Q, 

BRANCH [noLastCombOCOD 1, yesLastCombOCOD 1 ], 


c3, at [0D, 10, store - return]; 
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nolastCombOCODI: 

MAR_[sourceAddrHigh, sourceAddrLow + 0], CALL [getSourcel ], cl; 

yesLastCombOCOD 1: 

MAR_[destAddrHigh, destAddrLow +0], cl; 

yesLastComb0C0D2: 

otLow_uMa$k2, c2; 

sourceindex _ MD, GOTO [combOCOD], c3; 

yesLastCombOCOD: 

MAR_[destAddrHigh,destAddrLow + 0), GOTO (yesLastComb0C0D21, cl; 


^t****************************** CO mbinationRule = 0E ************ 

{-sourceWord bitlnvert bitOr: destinationWord bitlnvert-> 

combOCQE: 

MAR_[sourceAddrHigh, sourceAddrLow + 0], CALL [getSource], 


cl, at [0E, 10, combOC]; 


sourceindex_sourceindex and temp2Low, 

} 

otLow -sourceindex and otLow, CALL [store 13, 

destAddrLow _ destAddrLow + Q, 

BRANCH [noLastCombOCOE, yesLastCombOCOEl, 


cl, at [0E, 10, getSource - return); { sourceWord bitlnvert 
c2; 

c3, at (0E, 10, storel - return]; 


noLastCombOCOE: 

MAR _ [sourceAddrHigh, sourceAddrLow + 0), CALL [getSourcel], 
Noop, 

sourceindex __ MD and sourceindex. 


cl; 

c2, at{0E, 10, getSourcel - return]; 
c3; 


MAR_[destAddrHigh, destAddrLow + 0], 

MDR __ -sourceindex, 
bitlnvert} 

destAddrLow_destAddrLow + Q, 


cl; 

c2;{ sourceWord bitlnvert bitOr: destinationWord 
c3; 


Noop, cl; 

temp3Low _temp3Low - l.ZeroBr, c2; 

BRANCH [noLastCombOCOE 1, yesLastCombOCOE 1 ], c3; 


noLastCombOCOE 1: 

MAR_[sourceAddrHigh,sourceAddrLow + 0], CALL [getSourcell, cl; 

yesLastCombOCOEl: 

MAR _ [destAddrHigh, destAddrLow + 0], cl; 

yesLastComb0C0E2: 

otLow_uMask2, c2; 

sourceindex_MD, GOTO [combOCOE], c3; 


yesLastCombOCOE: 

MAR _ [destAddrHigh, destAddrLow + 0], GOTO [yesLastComb0C0E2], 


{ Edit history: 

13-Sep-85 13:29:06 Tokunga.fx modify when combination Rule = 6{comb0C06}} 
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MAR_[destAddrHigh, destAddrLow + 0], L3 _ 0, GOTO [combOEOOl], 


c1,at(0, 10, combOD]; 


MAR_[destAddrHigh, destAddrLow + 0], L3_OF, GOTO [combOEOFI], 


cl, at [OF, 10, combOD]; 


{********************** ccmbinationRule a 1 **********************} 

{-source Word bit And: destination Word -} 

combODOi: 

temp2Low _ sourceindex and temp2Low, 
temp2Low __ temp2Low and otLow, 
sourceindex _ sourceindex and —otLow, 


cl, at [1, 10, combOD]; { merging } 

c2; 

c3; 


temp2low __ temp2Low or sourceindex, L3 _ combODOi, cl; 

otLow uMask2, CALL [write3], c2; 


{ Subroutine : write 
entry : cl 

exit : c2 , pending zeroBr, Q = hDir > 

{ the click number * 7 dick in interation except first word and last word } 
write3: 

Noop, c3; 


write: 

MAR [destAddrHigh, destAddrLow + 0], L2 bbtCheckMlnt, cl; 

MDR ___ temp2Low, temp3Low _ temp3Low + 0, NZeroBr, c2; { Write and check} 

sourceindex_uPrevWord, BRANCH (finishedWrite, contWrite], c3; 


contWrite: 


MAR __ [sourceAddrHigh, sourceAddrLow + 0], L2 __ combOD, 
CALL [caiSkewWordl], 


cl; 


Q_uHDir, L3Disp, 

temp3Low_temp3Low ■ 


1, ZeroBr, RET (write - return]. 


cl, at [combOD, 10, calSkewWord - return]; 
c2; 


finishedWrite: 

destAddrLow _ destAddrLow + Q, GOTO ffinishedCombOEOO], 


{--• 


> 


destAddrLow _ destAddrLow + Q, 

BRANCH [noLastcombOD01, yesLastCombODO1 ], 


c3, at [combOD01,10, write - return]; 


noLastcombODOl: 

MAR _ [destAddrHigh, destAddrLow + 0], cl; 

temp2Low_temp2Low and uHalftoneWord, c2; 

temp2Low_MD and temp2Low, CALL [write], c3; { get and merging } 

yesLastCombODOl: 

MAR _ [destAddrHigh, destAddrLow + 0], cl; 

temp2Low_temp2Low and uHalftoneWord, c2; 

sourceindex_MD,GOTO [combODOi], c3; 


A****** *********** *# combi nation Ru le — 2 ****'******************j. 

{-sourceWord bitAnd: destination Word bitlnvert-} 

comb0D02: 

temp2Low_-sourceindex and temp2Low, 

sourceindex _ sourceindex and -otLow, 
temp2Low_temp2Low and otLow, 


cl, at (2, 10, combOD]; { merging } 

c2; 

c3; 


temp2Low_sourceindex or temp2Low, L3 _ comb0D02, cl; 

otLow __ uMask2, CALL [write3], c2; 


destAddrLow _ destAddrLow + Q, 

BRANCH (noLastComb0D02, yesLastComb0D02], 


c3, at [comb0D02, 10, write - return]; 


noLa$tComb0DQ2: 

MAR _ [destAddrHigh, destAddrLow + 0], 
temp2Low _ temp2Low and uHalftoneWord, 
temp2Low_-MD and temp2Low, CALL [write]. 


cl; 

c2; 

c3; { get and merging } 


yesLast€omb0D02: 
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cl; 
c 2; 
c3; 


MAR_[destAddrHigh, destAddrLow + 0], 

temp2Low __ temp2Low and uHalftoneWord, 
sourcelndex _MD, GOTO [000160002], 


^**it******************* combi nation Rule — 3 **********************} 

{-- sourceWord-} 

comb0D03: 

temp2Low_temp2Lowand otLow, cl, at [3,10, combOD]; { merging } 

sourcelndex _ sourcelndex and -otLow, 13 _ combODG3, c2; 

temp2low _ temp2Low or sourcelndex, CALL [write], c3; 


destAddrLow _ destAddrLow + Q, 

BRANCH [noLastcomb0D03, yesLastComb0D031, 


c3, at [comb0D03,10, write - return]; 


noLast<:omb0D03: 

MAR _ [destAddrHigh, destAddrLow + 0], cl; 

MDR _ temp2Low and uHalftoneWord, c2; 

sourcelndex __ uPrevWord, CALL [contWrite], c3; 


yesLastComb0D03: 

MAR __ [destAddrHigh, destAddrLow + 0], cl; 

temp2Low __ temp2Low and uHalftoneWord, c2; 

sourcelndex_MD, c3; 

otLow __ uMask2, cl; 

uBBTTemp_sourcelndex and -otLow, c2; 

otLow __ temp2Low and otLow, c3; 

MAR_[destAddrHigh, destAddrLow + 0], cl; 

MDR_otLow or uBBTTemp, c2; 

L2 _ bbtCheckMInt, GOTO [finishedWrite], c3; 


{************★********* C ombinationRule = 4 **********************} 

{-- sourceWord bitlnvert bitAnd; destinationWord — — } 

comb0D04: 

uBBTTemp_sourcelndex and -otLow, 

sourcelndex _ -temp2Low and sourcelndex, 
otLow _ sourcelndex and otLow, 


Cl, at [4, 10, combOD}; 
c2; { merging } 
c3; 


temp2Low_otLow or uBBTTemp, L3_comb0D04, cl; 

otLow_uMask2, CALL [write3], c2; 


destAddrLow __ destAddrLow + Q, 

BRANCH [noLa$tcomb0D04, yesLastComb0D04], 


c3, at [comb0D04,10, write - return]; 


noLastcomb0D04: 

MAR_[destAddrHigh, destAddrLow + 0], cl; 

temp2Low_temp2Low and uHalftoneWord, c2; 

sourcelndex __ MD, c3; { get} 

MAR_[destAddrHigh, destAddrLow + 0], cl; 

M DR _ -temp2Low and sourcelndex, c2; { merging } 

sourcelndex_uPrevWord, CALL [contWrite], c3; 


yesLastComb0D04: 

MAR_[destAddrHigh, destAddrLow + 0], cl; 

temp2Low_temp2Low and uHalftoneWord, c2; 

sourcelndex_MD, GOTO [comb0D04], c3; 


^ ** <r ***** * ************ * combi nation Rule = 5 *********** ,lr **********J 

{-- destinationWord-} 

combO D05: 

GOTO [allFinished], cl, at [5,10, combOD]; 


^***r******************* C ombinationRule — 6 **********************^. 

{-- sourceWord bitXor; destinationWord-> 

comb0D06: 

temp2Low_sourcelndex xor temp2Low, 

sourcelndex _ sourcelndex and -otLow, 
temp2Low_temp2Low and otLow, 


cl, at [6,10, combOD]; { merging } 

c2; 

c3; 


temp2Low _ temp2Low or sourcelndex, L3 _ comb0D06, cl; 

otLow_uMask2, CALL [write3], c2; 


destAddrLow _ destAddrLow +• Q, 

BRANCH [noLastComb0D06, yesLastComb0D06], 


c3, at [comb0D06, 10, write - return]; 


noLastCombODOB: 

MAR_[destAddrHigh, destAddrLow + 0], 

temp2Low_temp2Low and uHalftoneWord, 

temp2LOw_MD xor temp2Low, CALL [write], 


cl; 

c2; 

c3; { get and merging } 


yesLastComb0D06; 

MAR_[destAddrHigh, destAddrLow + 0], cl; 

temp2Low _temp2Low and uHalftoneWord, c2; 

sourcelndex_MD, GOTO [combODQB], c3; 
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^********************** combinationRu!e = 7 **********************^j, 

{-- sourceWord bitOr: destination Word-> 

comib0D07: 

temp2Low _ sourcelndex or temp2Low, 
sourcelndex_sourcelndex and -otLow, 
temp2Low _ temp2Low and otLow, 


cl, at 17,10, combODj; { merging } 

c2; 

c3; 


temp2Low_temp2Low or sourcelndex, L3_comb0D07, cl; 

otLow_uMask2, CALL [write3], c2; 


destAddrLow_destAddrLow + Q, 

BRANCH [noLastComb0D07, yesLastComb0D07j, 


c3, at [comb0D07,10, write - return]; 


noLastComb0D07: 

MAR _ [destAddrHigh, destAddrLow +■ 0], 

temp2Low_temp2Low and uHalftoneWord, 

temp2Low _ MD or temp2Low, CALL [write]. 


cl; 

c2; 

c3; { get and merging } 


yesLastComb0D07: 

MAR _ [destAddrHigh, destAddrLow + 0], cl; 

temp2Low _ temp2Low and uHalftoneWord, c2; 

sourcelndex MD, GOTO [comb0D07], c3; 


^********************** combinationRule — 3 jr ****** , ************** ,jr ^ 

{ --sourceWord bitlnvert bitAnd: destinationWord bitlnvert-} 

comb0D08: 

temp2Low ~temp2Low, cl, at [8,10, combOD]; { source bitlnvert } 

temp2Low temp2Low and —sourcelndex, c2; { merging } 

temp2Low _ temp2Low and otLow, c3; { skewWord and mergeMask} 


sourcelndex_sourcelndex and —otLow, 

temp2Low _ temp2Low or sourcelndex, L3 _ comb0D08, 
OtLow _ uMask2, CALL (write]. 


cl; 

c2; { concatination > 
c3; 


destAddrLow _ destAddrLow -t- Q, 

BRANCH [noLastcomb0D08, yesLastComb0D08], 


c3, at [comb0D08,10, write - return]; 


noLastcombQD08: 

MAR_[destAddrHigh, destAddrLow + 0], 

temp2Low __ temp2Low and uHalftoneWord, 
sourcelndex _ -MD, 


cl; 

c2; 

c3; { get inverted destination } 


MAR [destAddrHigh, destAddrLow + 0], cl; 

MDR ~temp2Low and sourcelndex, c2; 

sourcelndex __ uPrevWord, CALL [contWrite], c3; 


yesLastComb0D08: 

MAR_[destAddrHigh, destAddrLow + 0], cl; 

temp2Low temp2Low and uHalftoneWord, c2; 

sourcelndex _ MD, GOTO [combODOS], c3; 


{********************** combinationRule = 9 **********************} 

{ --sourceWord bitlnvert bitXor: destinationWord-} 

comb0D09: 

uBBTTemp_sourcelndex and -otLow, 

sourcelndex _ sourcelndex xor -temp2Low, 
otLow _ sourcelndex and otLow, 

temp2Low _ otLow or uBBTTemp, L3 _ comb0D09, 
otLow_uMask2, CALL [write3], 

destAddrLow_destAddrLow + Q, 

BRANCH [noLa$tcomb0D09, yesLastComb0D09], 


cl, at [9,10, combOD]; 
c2; { merging } 
c3; 

cl; 

c2; 


c3, at [comb0D09, 10, write-return]; 


noLastcomb0D09; 

MAR _ [destAddrHigh, destAddrLow + 0], cl; 

temp2Low temp2Low and uHalftoneWord, c2; 

sourcelndex _ M D, c3; { get and merging } 

MAR _ [destAddrHigh, destAddrLow + 0], cl; 

MDR __ sourcelndex xor ~temp2Low, c2; 

sourcelndex _ uPrevWord, CALL [contWrite], c3; 


yesLastComb0D09: 

MAR _ [destAddrHigh, destAddrLow + 0], cl; 

temp2Low temp2Low and uHalftoneWord, c2; 

sourcelndex MD, GOTO [comb0D09], c3; 


^ ********************** combinationRule — 0A *********** ,|f **** , ******j 

{ --destinationWord bitlnvert-> 

combODOA: 

MAR_[destAddrHigh, destAddrLow + 0], 

MDR _ sourcelndex xor otLow, 
temp3Low _ temp3Low + 0,ZeroBr, 

destAddrLow _ destAddrLow + Q, 

BRANCH [contCombODOA, finishedCombODOA], 


cl, at [0A, 10, combOD]; 

c2; 

c3; 


cl; 
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contCombODGA: 

temp3Low temp3Low - 1, ZeroBr, c2; 

BRANCH (noLastCombQDOA, yesLastCombODOA], c3; 


noLastCombQDOA: 

MAR _ [destAddrHigh, destAddrLow + 0], 
noLastComb0D0A2: 

NOOp, 

sourcelndex_~MD, 


cl; 

c2; 

c3; { get and bitlnvert } 


MAR __ [destAddrHigh, destAddrLow + 0], cl; 

MDR __ sourcelndex, temp3Low_temp3Low - 1, ZeroBr, c2; 

destAddrLow _ destAddrLow + Q, 

BRANCH [noLastCombODOAl, yesLastCombODOA?], c3; 


nolastCombODOA 1: 

MAR_(destAddrHigh, destAddrLow + 0], GOTO (noLastComb0D0A2], 


cl; 


yesLastCombODOA 1: 

MAR _ [destAddrHigh, destAddrLow + 0], cl; 

yesLastCombO DQA2; 

otLow _ uMask2, L2 bbtCheckMInt, c2; 

sourcelndex MD, GOTO [combODOA], c3; 


yesLastCom bO DO A: 

MAR_[destAddrHigh, destAddrLow + 0], GOTO [yesLastComb0D0A2], cl; 


f inishedCombODOA: 

temp3Low_uH, GOTO [finishedCombOEOOl], 


c2; 


{********************** combjnatjonRu i e _ 0B *************** 

{-sourceWord bitOr: destinationWord bitlnvert-} 

combO DOB: 

uBBTTemp_ sourcelndex and -otLow, 
sourcelndex _ sourcelndex and ~temp2Low, 
otLow __ ^sourcelndex and otLow, 

temp2Low _ otLow or uBBTTemp, L3_combODOB, 

otLow __ uMask2, CALL [writes], 

destAddrLow _ destAddrLow + Q, 

BRANCH [noLastCombODOB, yesLastCombODOB], 


t****^ 


cl, at [0B, 10,comb0D]; 

c2; { Dword and -Sword} 

c3; { skewWord and MergeMask } 

cl; 

c2; 


c3, at [combODOB, 10, write-return]; 


noLastCombODOB: 

MAR _ [destAddrHigh, destAddrLow + 0], cl; 

temp2Low_temp2Low and uHaiftoneWord, c2; 

sourcelndex_-MD, c3; { get and merging } 

MAR _ [destAddrHigh, destAddrLow + 0], cl; 

MDR _temp2Low or sourcelndex, c2; 

sourcelndex _ uPrevWord, CALL [contWrite], c3; 


yesLastCombODOB: 

MAR_[destAddrHigh, destAddrLow + 0], cl; 

temp2Low temp2Low and uHaiftoneWord, c2; 

sourcelndex __ MD, GOTO [combODOB], c3; 


{********************** C ombinationRule - OC **********************} 

{-sourceWord bitlnvert-} 

combO DOC: 

uBBTTemp _ sourcelndex and -otLow, L3 _ combODOC, c1,at[0C, 10, combOD]; { merging} 

otLow _ -temp2Low and otLow, c2; 

temp2Low _ otLow or uBBTTemp, CALL [write], c3; 

destAddrLow _ destAddrLow + Q, 

BRANCH [noLastcombODOC, yesLastCombQDOC], c3, at [combODOC, 10, write - return]; 


noLastcombODOC: 

temp2Low_temp2Low and uHaiftoneWord, cl; 

temp2Low _ ~temp2Low, c2; 

Noop, c3; 

MAR _ [destAddrHigh, destAddrLow + 0], cl; 

MDR _ temp2Low, c2; 

sourcelndex_uPrevWord, CALL [contWrite], c3; 

yesLastCombODOC: 

MAR __ [destAddrHigh, destAddrLow + 0], cl; 

temp2Low_temp2Low and uHaiftoneWord, c2; 

sourcelndex_MD, c3; 

otLow_uMa$k2, cl; 

uBBTTemp_sourcelndex and -otLow, c2; 

otLow _ -temp2Low and otLow, c3; 
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MAR __ [destAddrHigh, destAddrLow + 0], 

MDR_otLow or uBBTTemp, 

L2 __ bbtCheckMInt, GOTO [finishedWrite], 


cl; 

c2; 

c3; 


{********************** comb(natJonRu | e _ 0D *************** 

{-sourceWord bitlnvert bitOr: destination Word-} 

combODOD: 

uBBTTemp_sourceindex and -otLow, 

temp2Low _temp2Low and -sourceindex, 
otLow_otLow and ~temp2Low, 

temp2Low _ otLow or uBBTTemp, L3 __ combODOD, 
otLow_uMa$k2, CALL [write3], 

destAddrLow _ destAddrLow + Q, 

BRANCH {noLastcombODGD, yesLastCombODOD), 


:***^ 


cl, at [0D, 10, combOD]; { merging } 

c2; { SWord and-DWord > 

c3; { skewWord and Mergemask > 

cl; 

c2; 


c3, at [combODOD, 10, write - returnj; 


noLastcombODOD: 

MAR __ [destAddrHigh, destAddrLow + 0], cl; 

temp2Low _ temp2Low and uHaiftoneWord, c2; 

sourceindex_~MD and temp2Low, c3; { get and merging } 

MAR_[destAddrHigh, destAddrLow + 0], cl; 

MDR _ -sourceindex, c2; 

sourceindex _ uPrevWord, CALL (contWritel, c3; 

yesLastCombODOD: 

MAR_[destAddrHigh, destAddrLow + 0], cl; 

temp2Low _ temp2Low and uHaiftoneWord, c2; 

sourceindex _MD, GOTO [combODOD], c3; 


{********************** combinationRule * 0E **********************} 

{-- sourceWord bitlnvert bitOr: destination Word bitlnvert-- } 

combO DOE; 

uBBTTemp_ sourceindex and -otLow, 

temp2Low_temp2Low and sourceindex, 

otLow_otLow and ~temp2Low, 


cl, at (0E, 10, combODj; 

c2; 

c3; 


temp2Low_otLow or uBBTTemp, L3_combODOE, cl; 

otLow __ uMask2, CALL [write3], c2; 


destAddrLow _ destAddrLow + Q, 

BRANCH [noLastcombODOE, yesLastCombODOE], 


c3, at [combODOE, 10, write - return]; 


noLastcombODOE: 

MAR _ (destAddrHigh, destAddrLow + 0], 
temp2Low _ temp2Low and uHaiftoneWord, 
sourceindex_MD and temp2Low, 


cl; 

c2; 

c3; { get inveted destination } 


MAR_[destAddrHigh, destAddrLow + 0], cl; 

MDR __-sourceindex, c2; 

sourceindex_uPrevWord, CALL [contWrite], c3; 


yesLastCombODOE: 

MAR_(destAddrHigh, destAddrLow +0], cl; 

temp2Low_temp2Low and uHaiftoneWord, c2; 

sourceindex _ MD, GOTO [combODOE], c3; 


{ Edit history: 

> 
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^ **************** ************* **** combi nation Rule — o ***' 

{- '0 -> 

combOEOO: 

MAR __ [destAddrHigh, destAddrLow + 0], 
combOEO01: 

M DR _ sourcelndex and ~otlow, 
temp3Low _ temp3Low, ZeroBr, 


■*********************j 


cl, at [0,10, combOE]; 

c2; 

c3; 


destAddrLow _destAddrLow + Q, BRANCH (contCombOEOO, finishedCombOEOO], cl; 


contCombOEOO: 

temp3Low _ temp3Low - 1, ZeroBr, c2; 

temp2Low_temp2Low xor temp2Low, 

BRANCH [noLastCombOEO01, yesLastCombOEO01 ], c3; 

noLastCombO E001: 

MAR _ [destAddrHigh, destAddrLow + 0], cl; 

nolastCombOEO011: 

M DR _ temp2Low, temp3Low temp3Low - 1, ZeroBr, c2; { put Zero } 

destAddrLow __ destAddrLow + Q, 

BRANCH (noLastCombQE0Q2, yesLastComb0E002], c3; 


noLastCombO E002: 

MAR _ [destAddrHigh, destAddrLow + 0], GOTO [noLastCombOEOOl 1], cl; 


yesLastCombOEOOl: 

MAR_[destAddrHigh, destAddrLow + 0], L3Disp, CALL (getDestll, 


cl; 


yesLastComb0E002: 

MAR _ [destAddrHigh, destAddrLow +• 01, L3Disp, CALL [getDestl], 


cl; 


sourcelndex_MD, GOTO [combOEOO], 


c3, at [00,10, getDest - return]; 


finishedCombOEOO: 

temp3Low uH, GOTO [finishedCombOEO01], c2; 

finishedCombOEO01: 

temp3Low__temp3Low - 1, ZeroBr, c3; 

finishedComb0E002: 

uH __ temp3Low, BRANCH [vLoopContinue, allFinlshed], cl; 


vLoopContinue: 

No op, c2; 

CALL [checkMesalnterrupt], c3; 


^■***** **************************** combination Ru le = 1 ***' 

{ - —- sourceWord bitAnd: destinationWord-} 

combOEOI: 

uBBTTemp_sourcelndex and -otLow, 

sourcelndex _ sourcelndex and temp2Low, 
otLow_sourcelndex and otLow, CALL [storeOEl], 


’**********^ 


cl, at [1, 10, combOE]; { do nothing } 

c2; { merging } 

c3; 


storeOEl: 

MAR _ [destAddrHigh, destAddrLow + 0], cl; 

MDR _ otLow or uBBTTemp, L3Dlsp, c2; 

temp3Low_temp3Low + 0, ZeroBr, RET [storeOEl - return], c3; 


destAddrLow_destAddrLow + Q, BRANCH [contCombOEOI,finishedCombOEOl], cl, at (01,10,storeOEl - return]; 


contCombOEOl: 

temp3Low _temp3Low - 1, ZeroBr, c2; 

BRANCH [noLastComb0E01,yesLastComb0E0l], c3; 


noLastCombO E01: 

MAR _ [destAddrHigh, destAddrLow + 0], cl; 

naLastComb0E012: 
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Noop, 

sourcetndex_MD and temp2Low, CALL [storeOE2], 

c2; 

c3; { get and merging } 


storeOE2: 

MAR [destAddrHigh, destAddrLow + 0], L3Disp, cl; 

store0E21: 

MDR_sourcelndex, temp3Low_temp3Low - 1,zeroBr, 

RET [storeOE2 - return], c2; 

{*$$$$*$$$$$$$$$$$$$$$$$$$$$*$$**$$*$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$} 


destAddrLow __ destAddrLow + Q, 

BRANCH [noLastCombOE011, yesLastCombOE011 j. 

c3, at [01,10, storeOE2 - return]; 


noLastCombOEO11; 

MAR _ [destAddrHigh, destAddrLow + 0], GOTO [naLastCombGE012], 

cl; 


yesLastCombOEOV. 

MAR _ [destAddrHigh, destAddrLow + 0], L3Disp, CALL [getDestl], 

cl; 


yesLastCombOEOII: 

MAR_[destAddrHigh, destAddrLow + 0], L3DI$p, CALL [getDestl], 

cl; 


getDest: 

MAR_[destAddrHigh, destAddrLow + 0], L3Disp, cl; 

getDestl: 

otLow uMask2, RET [getDest - return], c2; 


sourcelndex_MD, GOTO [combOEOI], 

c3,at (01, 10,getDest- return]; 


finishedCombOEOI: 

temp3Low_uH, GOTO [finishedCombOEOOll, 

c2; 


**************************** C ombinationRule — 2 ************************* 

{-- sourceWord bitAnd: destination Word bitinvert-} 

comb0E02: 

uBBTTemp _ sourcetndex and ~otLow, 

temp2Low_temp2Low and ■'-sourcelndex, 

otLow_temp2Low and otLow, CALL [storeOEl], 

cl, at [2,10,comb0E]; 
c2; { merging } 
c3; 


destAddrLow _ destAddrLow + Q, BRANCH [contComb0E02, finishedComb0E02], 

cl, at [02,10, storeOEl - return]; 


contComb0E02: 

temp3Low_temp3Low - 1,Zero8r, 

temp2Low _ uHalftoneWord, BRANCH [noLastComb0E02, yesLastComb0E02], 

c2; 

c3; 


noL«istComb0E02: 

MAR _ [destAddrHigh, destAddrLow + 0], 
noLeistComb0E022: 

Noop, 

sourcelndex_~MD and temp2Low, CALL [storeOE2], 

cl; 

c2; 

c3; { get and merging > 


destAddrLow __ destAddrLow + Q, 

BRANCH [noLastComb0E02l, yesLastComb0E02l], 

c3, at [02,10, storeOE2 - return]; 


noLastComb0E021: 

MAR_[destAddrHigh, destAddrLow + 0], GOTO [noLastComb0E022], 

cl; 


yesLastComb0E02: 

MAR_[destAddrHigh, destAddrLow + 0], L3Disp, CALL [getDestl], 

cl; 


yesLast€omb0E021: 

MAR _ [destAddrHigh, destAddrLow + 0], L3Disp, CALL [getDestl], 

cl; 


sourcelndex _ MD, GOTO [comb0E02], 

c3, at [02,10, getDest - return]; 


finishedComb0E02: 

temp3Low_uH, GOTO [finishedCombQEOQI], 

c2; 


^*****fc***************'***#******** combinatlonRuie — 3 **********************®*******^ 

{-- sourceWord-> 

comb0E03: 

uBBTTemp_sourcelndex and ~otLow, 

cl, at [3,10, combOE]; 
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otLow temp2Low and otLow, c2; 

otLow _ otLow or uBBTTemp, c3; 

MAR_[destAddrHigh , destAddrLow + 0], cl; 

MDR _ otLow, temp3Low __ temp3Low + 0, ZeroBr, c2; 

destAddrLow _ destAddrLow + Q, BRANCH [contComb0E03, finishedComb0E03], c3; 


contComb0E03: 

temp3Low temp3Low - 1,ZeroBr, cl; 

BRANCH [noLastComb0E03, yesLastComb0E03], c2; 


noLastComb0E03; 

sourcelndex _temp2Low, CALL [storeOE2], c3; 

destAddrLow _ destAddrLow + Q, 

BRANCH [noLastComb0E031, yesLastComb0E03l], c3, at [03,10, store0E2 - return]; 


noLastComb0E031: 

MAR_[destAddrHigh, destAddrLow + 0], L3Disp, CALL [storeOE21J, 


yesLa$tComb0E03: 

CALL [getDestj, 


c3; 


yesLastComb0E03l: 

MAR_[destAddrHigh, destAddrLow + 0], L3Disp, CALL [getDestl], cl; 

sourcelndex _ MD, GOTO [comb0E03], c3, at [03,10, getDest - return]; 


finishedComb0E03: 

GOTO [finishedCombOEOO], 


{********************************* combinationRule = 4 ************* 

{-- sourceWord bitlnvert bitAnd: destinationWord-} 

comb0E!04: 

uBBTTemp _ sourcelndex {destination word) and ~otLow {mask}, 

sourcelndex_sourcelndex and -temp2Low {halftone word), 

comb0E041: 

otLow_sourcelndex and otLow, CALL [storeOEl], 


*****^ 


cl, at [4,10, combOE]; 
c2; 

c3; 


destAddrLow_destAddrLow + Q, BRANCH [contComb0£04, finishedComb0E04j, cl, at [04, 10, storeOEl - return]; 


contComb0E04: 

temp3Low _temp3Low - 1, ZeroBr, c2; 

BRANCH [noLastComb0E04, yesLastComb0E04], c3; 


noLastComb0E04: 

MAR_[destAddrHigh, destAddrLow + 0], 

noLastComb0E042: 

temp2Low_-uHalftoneWord, 

sourcelndex_MD and temp2Low, CALL [storeOE2], 


cl; 
c 2; 

c3; { get and merging } 


destAddrLow _ destAddrLow + Q, 

BRANCH [noLastComb0E041, yesLastComb0E041], 


c3, at [04, 10, storeOE2 - return]; 


noLa$tComb0E04l: 

MAR _ [destAddrHigh, destAddrLow + 0], GOTO [noLastComb0E042], 


yesLast€omb0E04: 

MAR_ [destAddrHigh, destAddrLow + 0], L3Disp, CALL [getDestl], 


cl; 


yesLastComb0EQ41: 

MAR _ [destAddrHigh, destAddrLow + 0], L3Disp, CALL [getDestl ], 


sourcelndex _MD, 


c3, at [04,10, getDest - return]; 


uBBTTemp __ sourcelndex and ~otLow, cl; 

sourcelndex_sourcelndex and ~temp2Low, GOTO [comb0E041], c2; 


finisheclComb0E04: 

temp3Low_uH, GOTO [finishedCombOEO01 ], 


c2; 


^********************************* combinationRule = 5 ************ 

{-- destinationWord — — } 

combO E05: 

GOTO [allFinished], 


*****^ 


cl, at [5, 10, combOE]; 
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{********************************* combinationRu l e _ 6 

{-sourceWord bitXor: destinationWord-} 

comb0E06: 

uBBTTemp source)ndex and -otLow, 

source! nd ex _ source Index xor temp2Low, 
otLow_sourcefndex and otLow, CALL [storeOEl], 


************************************ 


> 


cl, at [6,10, combOE]; { do nothing > 

c2; { merging } 

c3; 


destAddrLow_destAddrLow +- Q, BRANCH [contComb0E06, finishedComb0E06], cl, at [06, 10, storeOEl - return}; 


contComb0E06: 

temp3Low temp3Low - I.ZeroBr, c2; 

BRANCH [noLastComb0E06, yesLastComb0E06], c3; 


noLastComb0E06: 

MAR [dest Add r High, destAddrLow + 0], 

noLastComb0E062: 

Noop, 

sourcefndex_MD xor temp2Low, CALL [store0E2|, 


cl; 

c2; 

c3; { get and merging } 


destAddrLow_destAddrLow + Q, 

BRANCH [noLastComb0E061, yesLastComb0E061], c3, at [06, 10, storeOE2 - return}; 


noLastComb0E06l: 

MAR_[destAddrHigh, destAddrLow +• 0}, GOTO [noLastComb0E062], 


cl; 


yesLastComb0E06: 

MAR _ [destAddrHigh, destAddrLow + 0], L3Disp, CALL [getDestl], 


cl; 


yesLastComb0E061: 

MAR ___ (destAddrHigh,destAddrLow +• 0], L3Disp, CALL [getDestl], cl; 

sourcelndex __ MD, GOTO [comb0E06], c3, at (06,10, getDest - return]; 


finishedComb0E06: 

temp3Low_uH, GOTO [finishedCombOEOOl], 


c2; 


^*■*■*’***■■*+****+***■*:**+**★+**+****** ^QmjjjpgtjonRule ~ 7 ******************************}, 

{-- sourceWord bitOr: destinationWord-} 

comb0E07: 

uBBTTemp _ sourcelndex and -otLow, cl, at (7,10, combOE]; {do nothing} 

sourcelndex __ sourcelndex or temp2Low, c2; { merging } 

otLow _ sourcelndex and otLow, CALL (storeOE 1 ], c3; 

destAddrLow __destAddrLow + Q, BRANCH [contComb0E07,finishedComb0E07], cl, at (07,10, storeOEl - return]; 


contComb0E07: 

temp3Low _temp3Low - 1,ZeroBr, c2; 

BRANCH [noLastComb0E07, yesLastComb0E07], c3; 


noLastComb0E07: 

MAR __ [destAddrHigh, destAddrLow + 0], 
noL<i$tComb0E072: 

Noop, 

sourcelndex_MD or temp2Low, CALL [store0E2], 


cl; 

c2; 

c3; { get and merging } 


destAddrLow_destAddrLow + Q, 

BRANCH [noLastComb0E071, yesLastComb0E071 ], 


c3, at [07,10, store0£2 - return]; 


noLastComb0E071: 

MAR __ [destAddrHigh, destAddrLow + 0], GOTO [noLastComb0E072], 


yesLastComb0E07: 

MAR_[destAddrHigh, destAddrLow + 0], L3Disp, CALL [getDestl], 


cl; 


yesLastComb0E071: 

MAR _ [destAddrHigh, destAddrLow + 0], L3Disp, CALL [getDestl], 


cl; 


sourcefndex _ MD, GOTO [comb0E07], 


c3, at [07,10, getDest - return]; 


finishedComb0E07: 

temp3Low __uH, GOTO [finishedCombOEOOl], 


c2; 


^a******************************** ^ombinationRule = 8 ************** 
{-sourceWord bitiinvert bitAnd: destinationWord bitlnvert-} 
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combO E08: 

uBBTTemp _ sourcelndex and -otLow, 
temp2Low _ ~temp2Low, 
combOEOSI: 

temp2Low_-sourcelndex and temp2Low, 


cl, at (8,10, combOEj; 
c2; { sourceWord bitlnvert} 

c3; { merging } 


otLow_temp2Low and otLow, 

otLow ___ otLow or uBBTTemp, 
Noop, 


cl; 

c2; 

c3; 


MAR [destAddrHigh, destAddrLow + 0}, cl 

MDR otLow, temp3Low temp3Low + 0, ZeroBr, c2 

destAddrlow _ destAddrLow + Q, BRANCH (contCombOEOa, finishedCombOEQ8], c3 


contCombOEOS: 

temp3Low __ temp3Low - 1, ZeroBr, cl; 

temp2Low __ -uHaiftoneWord, BRANCH (noLastComb0£08, ye$LastComb0E08], c2; 


nolastComb0E08: 

Noop, 


c3; 


noLastComb0E081: 

MAR_[destAddrHigh, destAddrLow + 01, 

Noop, 

sourcelndex _ -MO and temp2Low, CALL (store0E2], 


cl; 

c2; 

c3; { get and merging } 


destAddrLow _destAddrLow + Q, 

branch [noLastComb0E081, yesLastComb0E081L 


c3, at (08, 10, store0E2 - return]; 


yesLastComb0E08: 

CALL (getDestl, 


c3; 


ye$LastComb0E081: 

MAR _ [destAddrHigh, destAddrLow + 01, L3Disp, CALL [getDestl], 


cl; 


sourcelndex_MD, 


c3, at [08,10, getDest - return]; 


uBBTTemp_ sourcelndex and -otLow, cl; 

GOTO [comb0E081], c2; 


finishedComb0E08: 

GOTO [finishedCombOEOOl, 


cl; 


^ **** # #* * **** **** *■** ****** * ******* combinationRule — 9 ******************************^ 

{-- sourceword bitlnvert; bitXor; destinationWord-} 

combO E09: 

uBBTTemp_ sourcelndex and -otLow, cl, at [9,10, combOE]; 

sourcelndex __ sourcelndex xor -temp2Low, c2; { merging } 

comb0E091; 

otLow _ sourcelndex and otLow, CALL [storeQEl], c3; 

destAddrLow_destAddrLow + Q, BRANCH [contComb0E09, finishedComb0E09], cl, at [09,10, storeOEl - return!; 


contComb0E09: 

temp3Low _ temp3Low - 1, ZeroBr, c2; 

temp2Low _ -temp2Low, BRANCH [noLastComb0E09, yesLastComb0E09], c3; 


noLastCombQE09; 

MAR _ [destAddrHigh, destAddrLow + 01, cl; 

noLastComb0E092: 

Noop, c2; 

sourcelndex _ MD xor temp2Low, CALL [store0E2], c3; 


destAddrLow _destAddrLow + Q, 

BRANCH [noLastComb0E091, yesLastComb0E091 ], 


c3, at [09, 10, store0E2 - return]; 


noLastComb0E091: 

MAR __ [destAddrHigh, destAddrLow + 0], GOTO [noLastComb0E092], 


cl; 


yesLastComb0E09; 

MAR __ [destAddrHigh, destAddrLow + 0], L3Disp, CALL (getDestl 1, 


cl; 


yesLastComb0E09l: 

MAR_[destAddrHigh, destAddrLOW + 0], L3Disp, CALL [getDestl], 


cl; 


sourcelndex __MD, 


c3, at [09, 10, getDest - return]; 


uBBTTemp_ sourcelndex and -otLow, cl; 

sourcelndex _ sourcelndex xor temp2Low, GOTO [comb0E09t], c2; 


finishedComb0E09: 

temp3Low _uH,GOTO [finishedCombOEOOl], 


c2; 
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^*,******************************* combinationRule = OA ******************************} 


{-- desinationWord bitlnvert-} 

combOEOA: 

u8BTTemp_ sourcelndex and -otLow, c1,at[0A, 10, combOE]; 

otlow -soureelndex and otLow, c2; 

otlow __ otLow or u B BTTemp, c3; 

MAR_[destAddrHigh, destAddrLow + 0], cl; 

MDR_otLow, temp3Low_temp3Low *■ 0, ZeroBr, c2; 

destAddrLow_destAddrLow + Q, BRANCH [contCombQEOA,fini$hedCombOEQAl, c3; 


contCombOEOA: 

temp3Low temp3Low - 1, ZeroBr, cl; 

BRANCH [noLastCombOEOA, yesLastCombOEOAl, c2; 


noLastCombOEOA: 

Noop, c3; 

noLastCombOEOA 1: 

MAR_[destAddrHigh, destAddrLow + 0] 

Noop, 

sourcelndex _ - MD, CALL [storeOE2], 

destAddrLow _ destAddrLow + Q, 

BRANCH [noLastCombOEOA 1, yesLastCombOEOAl], c3, at [OA, 10, storeOE2-return!; 


cl; 

c2; 

c3; { get and merging > 


yesLastCombOEO A: 

CALL [getDest], 


c3; 


yesLastCombOEOAl: 

MAR _ [destAddrHigh, destAddrLow +• 0}, L3Disp,CALL [getDestl], cl; 

sourcelndex _ MD, GOTO (comb0E0A|, c3, at (0A, 10, getDest - return!; 


finishedCombOEOA; 

GOTO [finishedCombOEOO], 


^********************************* cornb j natjonRu l e _ 08 ******* 

{-- sourceword bitOr: destinationWord bitlnvert-} 

combO EiOB: 

u8BTTemp_sourcelndex and -otLow, 

sourcelndex _ ~temp2Low and sourcelndex, 

otLow_-sourcelndex and otLow, CALL [storeOEl], 


**■ 


r > 


cl, at [0B, 10, combOE]; 

c2; { merging } 

c3; 


destAddrLow _destAddrLow + Q, BRANCH (contCombOEOB, ftnishedCombOEOBj, cl, at [0B, 10, storeOEl - return}; 


contCombOEOB: 

temp3Low _temp3Low - 1, ZeroBr, c2; 

BRANCH [noLastCombOEOB, yesLastCombOEOB], c3; 

noLastCombOEOB: 

MAR __ [destAddrHigh, destAddrLow + o), cl; 

noLastComb0£0B2: 

Noop, c2; 

sourcelndex_—MD, c3; { get} 

sourcelndex __ sourcelndex or temp2Low, cl; {merging} 

Noop, c2; 

CALL [storeOE2], c3; 


noLastCombOEOB 1: 

MAR_ [destAddrHigh, destAddrLow + 0], GOTO [noLastComb0E0B2], 


cl; 


destAddrLow_destAddrLow + Q, 

BRANCH [noLastCombOEOBI, yesLastCombOEOB1], c3, at (0B, 10, $toreOE2 - return}; 

yesLastCombOEOB: 

MAR __ [destAddrHigh, destAddrLow + 0|, L3Disp, CALL [getDestl], cl; 


yesLastCombOEOB 1: 

MAR _ [destAddrHigh, destAddrLow + 01, L3Disp, CALL [getDestl], 


cl; 


sourcelndex_MD, GOTO [combOEOB], 


c3, at [0B, 10, getDest - return]; 


finishedCombOEOB: 

temp3Low_uH, GOTO [finishedCombQEOOl], 


c2; 
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^********************************* combinatlonRule = OC ******************************■}. 


{-- sourceWord bitinvert-} 

combOEOC; 

uBBTTemp_sourcelndex and -otLow, cl, at [OC, 10, combOE]; 

otLow _ -temp2Low and otLow, c2; 

OtLow otLow or uBBTTemp, c3; 

MAR __[destAddrHigh , destAddrlow + 0), cl; 

MDR_otLow, temp3Low _temp3Low + O.ZeroBr, c2; 

destAddrlow _destAddrLow + Q, BRANCH (contCombOEOC, finishedCombOEOC], c3; 


conlCombGEOC: 

temp3Low_temp3Low - 1,ZeroBr, cl; 

BRANCH [noLastCombOEOCyesLastCombOEOC], c2; 


noLastCombOEOC: 

sourcelndex __ ~temp2Low, CALL [storeOE2], c3; 


nolastCombOEOCI: 

MAR_[destAddrHigh, destAddrLow + 0], L3Disp, CALL [storeOE21], 


destAddrlow _destAddrLow + Q, 

BRANCH [noLastCombOEOCI, yesLastCombOEOCI], 


c3, at [OC, 10, store0£2 - return!; 


yesLastCombOEOC; 

CALL [getDest], 


c3; 


yesLastCombOEOCI: 

MAR __ [destAddrHigh, destAddrLow + 0], L3Disp, CALL (getDest 1], 


cl; 


sourcelndex _ MD, GOTO [combOEOC], 


c3, at [OC, 10, getDest - returnl; 


finishedCombOEOC: 

GOTO [finishedCombOEOO}, 


cl; 


{*************•******************* combinatlonRule = 0D *** : 

{-sourceWord bitinvert bitOr: destinationWord-> 

combOEOD: 

uBBTTemp_sourcelndex and -otLow, 

temp2low_temp2Low and -sourcelndex, 

otLow _ -temp2Low and otLow, CALL [storeOEIJ, 


**************** * * * * * * ^ 


cl,at [0D, 10, combOEJ; 

c2; { merging } 

c3; 


destAddrLow _ destAddrLow + Q, BRANCH [contCombOEOD,finishedCombOEOD], c1,at[0D, 10,store0E1 - return]; 


contCombOEOD: 

temp3Low _temp3Low - 1, ZeroBr, c2; 

BRANCH [noLastCombOEOD, yesLastCombOEOD], c3; 

noLastCombOEOD: 

MAR_[destAddrHigh, destAddrLow + 0], cl; 

nolastComb0E0D2: 

temp2Low_-temp2low, c2; 

sourcelndex _ MD, c3; { get and merging } 

sourcelndex _ sourcelndex ortemp2Low, cl; 

temp2Low_~temp2Low, c2; 

CALL [store0E2], c3; 


noLastCombOEODI: 

MAR_[destAddrHigh, destAddrLow + 0],GOTO [noLastCombOEOD2], cl; 

destAddrLow __destAddrLow + Q, 

BRANCH [noLastCombOEOD 1, yesLastCombOEOD 1], c3, at [0D, 10, storeOE2 - returnj; 


yesLastCombOEOD: 

MAR __ [destAddrHigh, destAddrLow + 0], L3Disp, CALL [getDestl], 


yesLastCombOEODl: 

MAR _ [destAddrHigh, destAddrLow + 0], L3Disp, CALL [getDestl], 


cl; 


sourcelndex _ MD, GOTO [combOEOD], 


c3, at [0D, 10, getDest - return]; 


f i n ishedCombOEOD: 

temp3Low _ uH, GOTO [finishedCombOEO01], 


c2; 
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{A******************************** combinationRule = OE *************' 

{-- - sourceWord bitlnvert bitOr: destinationWord bitlnvert-} 

combOEQE: 

uBBTTemp_sourcelndex and -otLow, 

sourcelndex _ -sourcelndex, 
sourcelndex_sourcelndex and ~temp2Low, 


**********^ 


c1,at[0E, 10, combOE]; 

c2; { destinationWord bitlnvert} 

c3; { merging } 


otlow __ sourcelndex and otLow, 

otLow_otLow or uBBTTemp, 

Noop, 


cl; 

c2; 

c3; 


MAR_[destAddrHigh, destAddrLow + 0], cl; 

MDR_otLow, temp3Low_temp3Low + 0,ZeroBr, c2; 

destAddrLow_destAddrLow + Q, BRANCH [contCombOEOE, finishedCombOEOE], c3; 


contCombOEOE: 

temp3Low_temp3Low - 1,ZeroBr, cl; 

BRANCH [noLastCombOEOE, yesLastCombOEOE], c2; 


noLastCombOEOE: 

Noop, c3; 


noLastCombOEOE 1: 

MAR __ [destAddrHigh, destAddrLow + 0], 
temp2Low _ ~temp2Low, 
sourcelndex _ ~MD, 


cl; 
c 2; 

c3; { get and merging } 


sourcelndex_sourcelndex or temp2Low, cl; 

temp2Low_-temp2Low, c2; 

CALL [storeOE2j, c3; 


destAddrLow _ destAddrLow + Q, 

BRANCH [noLastCombOEOE 1, yesLastCombOEOE 1 j. 


c3, at [OE, 10, storeOE2 - return); 


yesLastCombOEOE. 

CALL [getDest], 


c3; 


yesLastCombOEOE 1: 

MAR [destAddrHigh,destAddrLow + 0], L3Disp, CALL [getDest 1], cl; 

sourcelndex_MD, GOTO [combOEOE], c3,at[0E, 10, getDest-return]; 


finishedCombOEOE: 

GOTO [finishedCombOEOO], 


cl; 


£******■#*******»«******* *********** combinationRule — OF *************************** 

{ --sourceWord-} 

combOEOF: 

MAR_, [destAddrHigh, destAddrLow + 0], 

combOEOF 1: 

MDR _ sourcelndex or otlow, 
temp3Low_temp3Low, ZeroBr, 


*} 


cl, at [OF, 10, combOE]; 

c2; 

c3; 


destAddrLow_destAddrLow + Q, BRANCH [contCombOEOF,finishedCombOEOE], cl; 

contCombOEOE: 

temp3Low __ temp3Low - 1, ZeroBr, c2; 

sourcelndex __ sourcelndex xor - sourcelndex, 

BRANCH [noLastCombOEOFI, yesLastCombOEOFI], c3; 


noLastCombQEOF 1: 

MAR_[destAddrHigh, destAddrLow + 0], 

noLastCombOEOF11: 

MDR_sourcelndex, temp3Low_temp3Low - 1, ZeroBr, 

destAddrLow_destAddrLow + Q, 

BRANCH [noLastComb0E0F2, yesLastCombOEOF2], 


cl; 

c2; { put Zero } 
c3; 


nolastComb0E0F2: 

MAR_[destAddrHigh,destAddrLow + 0], GOTO [noLastCombOEOF11], cl; 


yesLastCombOEOFI: 

MAR_[destAddrHigh, destAddrLow + 0], L3Disp, CALL [getDest 1], cl; 


yeslastComb0E0F2: 

MAR _ [destAddrHigh, destAddrLow + 0], L3Disp, CALL [getDest 1], 


cl; 


sourcelndex _ MD, GOTO [combOEOF], 


c3, at [OF, 10, getDest - return]; 


finishedCombOEOF: 
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temp3Low_uH, GOTO [finishedCombOEOOl], 


c2; 


{ Edit history: 

> 
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{ BBT.mc 

Bitblt primitive for Rum, the Dandelion Smalltalk - 80 mtcrocoded virtual machine, 
by T Tokunaga, M Sakakibara, J Trow 
14- Feb-86 16:50:25 

Copyright 1985, 1986 by Xerox Corporation. All rights reserved. } 


{ <primitive: 96> BltBit > > copyBits 

Perform the movement of bits from one Form to another described by the instance variables of the receiver. Fail if any instance 
variable is not of the right type (Integer or Form) or if combinationRule is not between 0 and 15 inclusive. Set the variables 
and try again (BitBIt > >copyBitsAgain). 

<nput: 

output: 

smash: } 


primitiveCopyBits: 

jSaveiPL_ipLow, 

ipLow_ipHigh , 

uSavelPH_ipLow. 

jSaveStackL _ stackLow, 

stacKLow_stackHigh, 

jSaveStackH __stacklow. 


cl: 

c2; 

c3; { save Smalltalk Instruction Pointer } 

cl; 

c2: 

c3; { save Smalltalk Stack Pointer } 


uSaveHomel __ homeLow. 
homeLow __ nomeHigh. 
uSaveHomeH _ homeLow, 


cl; 

c2; 

c3; { save the Pointer to home context } 


checkMesaStackP: 

xbus _ ErrnlBnStkp, XDisp. 

DISP4 (bitBItHowBigStack. 7}, 

stackLow _ jSaveStackL, GOTO (normalEntry], 


cl; { X (12—151 __ -stackP) 
c2; { Only for case of Mesa int } 
c3, at (OF, 10, bitBItHowBigStack]; 


{- 

— After Mesa Interrupt 


> 


{At this point, part of the Parameters of Smalltalk BitBIt are stored in following order} 


Oop for bitblt Argument 

i uDestBitMap 

| U02 

Loop counter (Vertical) 

i ui 

| U03 

Destination Address(low) 

1 uDestAddrLow 

| U04 

Destination Address(high) 

i *uDestAddrHigh 

| U05 

uSource, Dest Delta 

; *uDe5tDelta 

I U06 

uMaksI 

i Maskl 

I U07 

uMask2 

i Mask2 

j U08 

uSkewMask 

| skew Mask 

1 U09 

uMisc 

i *Misc 

I UOA 

uNWords 

| NWords 

! UOB 

uHalftoneAddrLow 

1 HalftoneAddrLow 

| UOC: 

uSourceAddrLow 

1 SourceAddrLow 

UOD : 

uSaveHighAddr 

: *SaveHighAddr 

! U0E 


************ uDestAddrHigh 
00 - 03 : unused 

04 - 07 : combinationRule 

08-15 : destination Address high 

************ uMisc 

00 ~ 03 : DY’s offset< IS Nibble) 

04 - 07 : skew 

08 : unused 

09 : vDir = -1? 

0A : hDir = - 1? 

OB : unused 

0C : skew = 0? 

0D . halftoneFormNlL — 1 - > halftoneForm = Nil, 0 - > halftoneForm nonNII 

0E sourceFormNIL — 1 - > sourceForm = Nil, 0 - > sourceForm nonNil 

OF : preload — 1 - > preload True(uPreload = all 1),0 - > preload False(uPreload =0) 
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**************** uSaveHighAddr 

00 - 07 : High address of Source bitMap 

08 - OF : High address of Halftone bitmap 

**************** uDestDelta 
00 - 07 : source Oelta 

08 - OF : dest Delta 

Note : it means that these parameters without * marking is used for calculating the parameter again used in copyLoop 

} 


{ Now, We calculate the parameter(ma$k1, Mask2, skewMask, skew, 
afterMesalnt: 

temp2Low_uMisc, XwdDisp, 

after Mesafntl: 

Q _ 1. DISP2 {checkDirMInt], 


{vDir = hDir = 1} 

uVDir_Q, 

uHDir _ Q, GOTO [checkSkew], 


{vDir = 1, hDir = - 1 > 

uHDir_temp2Low xor ~temp2Low, 

uVDir __ Q, GOTO {checkSkewl, 


{vDir = - 1, hDir = 1} 
uHDir_Q, 

uVDir __ temp2Low xor ~temp2Low, GOTO (checkSkew}, 


'Dir, hDir, preload) used in copybit Loop, again. } 

c3, at (07,10, bitBitHowBigStack]; 

cl; 

c2, at (0,4, checkDirMInt]; 
c3; 

c2, at [1,4, checkDirMInt]; 
c3; 


c2, at (2, 4, checkDirMInt}; 
c3; 


{vDir - 1, hDir a - 1} 

uVDir_temp2Low xor ~temp2Low, 

uHDir _ temp2Low xor -temp2Low, 


c2, at (3, 4, checkDirMInt]; 
c3; 


checxSkew: 

temp3Low_temp2Low and OF, YDisp, cl; {temp2Low = 00 -03:DY, 04 -07:skew, 09;hdir, 0A;vDir, 

0c- OF: booleans} 
uBooleans temp3Low, 

BRANCH [skewNonZeroAfterMlnt, skewZeroAfterMInt, 7], c2; 


skewNonZeroAfterMInt: 

sourcelndex_temp2Low LRot8, 


c3; 


sourcelndex _ sourcelndex and OF, 
skew _ sourcelndex LRotO, 

GOTO (checkForm], 


cl; 

c2; {restore skew) 
c3; 


skewZeroAf ter M f nt: 

skew 0, c3; {restore skew) 

checkForm: 

temp3Low _ uDestDelta, XLDIsp, cl; 

destAddrlow _temp3Low and OFF, BRANCH (destDeltaP,destDeitaM, 1], c2; 

destDeltaM: 

destAddrLow _destAddrLow xor -OFF, c3; { create minus value for destDelta) 


Noop, cl; 

Noop, c2; 

destDeltaP: 

uDestDelta_destAddrLow, c3; {DestDelta) 

xbus_uBooleans, XDisp, cl; 

sourcelndex _ uSaveHighAddr, DISP4 (checkFormNil, 9], c2; 


{both nonNil) 
bothNonNil: 

templHigh _ sourcelndex LRotO, 

tempi Low _ uHalftoneAddrLow, 
temp2Low _ temp2Low LRot4, 
uDY_temp2Low, 

restoreSAddr: 

otLow_ sourcelndex LRot8, 

sourceAddrHigh_otLow LRotO, 

sourceAddrLow _ uSourceAddrLow, 

restoreSDelta: 

temp3Low_temp3Low LRot8, XLDisp, 

temp3Low _ temp3Low and OFF, BRANCH (sourceDeltaP, 


c3, at [9, 10, checkFormNil]; {highaddress of halftone) 

c 1; {low address of halftone form} 
c2; 

c3; {save dy’s offset) 


cl; 

c2; {highaddress of source) 
c3; {low address of source Form } 


cl; { check sourceDelta < 0} 
I, 1], c2; 


sourceDeltaM: 

temp3Low_temp3Low xor -OFF, GOTO [sourceDeltaPI ], 


c3; 
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sourceDeitaP: 

Noop, c3; 

sourceDeftaPI: 

uSourceDelta_temp3low, c 1; { sourceDelta} 

sourceAddrLow _ sourceAddrLow + temp3Low, GOTO [bothNilAfterMInt], c2; 


{SForm = nil, HForm = nonNii} 
sNilhNonNil: 

tempi High __ sourcelndex LRotO, c3, at [OB, 10, checkFormNii]; 


tempi Low_uHalftoneAddrlow, 

temp2Low _ temp2Low LRot4, 
temp2Low __ temp2Low and OF, 


cl; { halftone form address) 

c2; 

c3; 


uDY _ temp2Low, GOTO [bothNilAfterMIntl], 


cl; {dy'soffset) 


{SForm = nonNii, HForm = nil) 
sNonNilhNil: 

GOTO [restoreSAddr], c3, at [0D, 10, checkFormNii]; 


{both nil) 
bothNilAfterMIntl: 

Noop, c2; 

bothNilAfterMInt; 

otLow _ uDestAddrHigh, c3, at [OF, 10, checkFormNii]; {otLow = destdeita) 


destAddrHigh _ otLow LRotO, cl; 

otLow _ OtLow LRota, c2; 

uCombinationRuie_otLow, c3; 


goVLoopMInt: 

otLow_uDestAddrLow cl; {otLow = destdeita) 

destAddrLow __ destAddrLow + otLow, Xbus _ uBooleans, XDisp, 

L2 _ bbtChecKMInt, GOTO [startVLoopl], c2; { restore destination address (16 bit)) 


First Entry for Smalltalk Bitblt 


) 

normall-ntry: 

MAR_[stackHigh, stackLow + 0], 

Li _ getParameter, 

OtLow_MD, CALL [otMap2BankO], 

normalEntryl: 

tempi Low __ tempi Low + firstFieldOfObject, 
the destinationForm } 

uArgument_otLow, 

Q_nil Pointer, 

{ Now get the BilBlt Argument) 
normalEntry2: 

MAR_[tempi High, tempi Low + 0], 

tempi Low __ tempi Low + i, 
destAddrLow_MD, 

normal lintry3: 

MAR_[tempi High, tempi Low + 0], 

tempi Low_tempi Low + 1, 

sourceAddrLow _ MD, 

normal Entry4; 

MAR __ [tempi High, tempi Low + 0], 

temp 1 Low _ tempi Low 1, LI checkCombinationRule, 

otLow_M D, 

w*********^ 

[]_otLow and nonPointerMask, ZeroBr, 

[]_destAddrLow and nonPointerMask, ZeroBr, 

BRANCH {$, halftoneNonOop], 

[] _ sourceAddrLow and nonPointerMask, ZeroBr, 

BRANCH [$, destinationNonOopl, 


cl; 

c2; 

c3; { get the real address of object} 


cl, at [getParameter, 10, otMap2BankO - return]; { Point 

c2; { save the original Oop ) 
c3; 


cl; 

c2; { point the SourceForm ) 
c3; { get destination Form ****** } 

£l> ^***********^ 

c2; { point the halftoneForm } 
c3; { get source Form ******** } 

{**********) 

c2; { point the combinationRule > 

c3; { get halftoneForm and check three Oop of Form 


cl; 

c2; 

c3; 


normal Entry 5: 

MAR_[tempi High, tempi Low + 0], BRANCH [$, sourceNonOop], cl; 

uDestForm _ destAddrLow, CALL [checkSmalllnt], c2; {save destination Form ) 


normalEntrySS: 

[]_temp2Low and ~0F, ZeroBr, 

BRANCH [combinationRuleTooBIg, $], 
Noop, 


cl, at (checkCombinationRule, 10, checkSmalllnt - return]; 

c2; 

c3; 


normallEntry6: 

MAR_[tempi High, temp I Low + 0], LI _checkDestX, cl; 

uCombinationRuie _ temp2Low, CALL [checkSmalllnt], c2; 
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normalEntry7: 

MAR _ [tempi High, tempi Low + 0}, LI __checkDestY, 
uDestX _ temp2Low, CALL [checkSmalllnt], 

normal£ntry8: 

MAR __ [tempiHigh, tempILow + 0], LI_checkDestWidth, 

uDestY _temp2Low, CALL [checkSmalllnt], 

normalEntry9: 

MAR _ [tempiHigh, tempILow + 0], LI_checkDestHeight, 

uDestWidth_temp2Low, CALL [checkSmalllnt], 

normaiEntrylO: 

MAR__ [tempiHigh,tempILow + 0], LI __ checkSourceX, 
uDestHeight_temp2Low, CALL [checkSmalllnt], 

normalEntryl 1: 

MAR __ [tempiHigh,tempILow + 0), LI __ checkSourceY, 
uSourceX __temp2Low, CALL [checkSmalllnt], 


cl, at [checkOestX, 10, checkSmalllnt-return]; 
c2; 


cl, at [checkDestY, 10. checkSmalllnt - return}; 
c 2; 


cl, at [checkDestWidth, 10. checkSmalllnt-return]; 
c2; 


cl, at [checkDestHeight, 10, checkSmalllnt - return]; 
c2; 


cl, at [checkSourceX, 10, checkSmalllnt - return]; 

c2; 


normalEntryl2: 

MAR _ [tempiHigh, tempILow + 0], LI_checkdipX, 

uSourceY_temp2Low, CALL [checkSmalllnt], 

normalEntry13: 

MAR _ (tempi High, tempi Low + 0], LI _checkClipY, 
uClipX _ temp2Low, CALL [checkSmalllnt], 


cl, at [checkSourceY, 10, checkSmalllnt - return]; 
c2; 


cl, at [checkClipX, 10. checkSmalllnt-return]; 

c2; 


normalEntry 14: 

MAR __ [tempiHigh, tempILow + 0], LI_checkClipWidth, 

uClipY __ temp2Low, CALL [checkSmalllnt], 

normalEntryl 5: 

MAR_[tempiHigh, tempILow + 0], LI _ checkClipHeight, 

uClipWidth _ temp2Low, CALL [checkSmalllnt], 


cl, at (checkClipY, 10, checkSmalllnt - return]; 

<2; 


c l, at (checkClipWidth, 10. checkSmalllnt - return]; 
c2; 


normalEntry 16: 

(3 _sourceAddrLow - Q, ZeroBr, (Q ; nilPointer} 

[j_otLow - Q, ZeroBr, BRANCH (sourceFormNonNilXX, sourceFormNilXX], 


cl, at [checkClipHeight, 10, checkSmalllnt - return); 
c2; 


sourceFormNonNilXX: 

destAddrLow _ 0, 8RANCH [halftoneFormNonNilXXI, haiftoneFormNilXXI], 


c3; 


sourceFormNilXX: 

destAddrLow_2, BRANCH [halftoneFormNonNilXXI, haiftoneFormNilXXI], 


c3; { halftoneform = nil } 


halftoneFormNonNilXX 1: 

GOTO [saveOop], 


cl; 


haiftoneFormNilXXI: 

destAddrLow_destAddrLow or 4, GOTO [saveOop], 


cl; { sourceForm = nil } 


saveOop: 

uBooleans _ destAddrLow, 
halftoneformNil} 

Q_uCiipHeight_temp2Low, 

normalEntry17: 

uSourceForm _ sourceAddrLow, 
uHalftoneForm_otLow, 


c2; {save the boolean, so far sourceformNil, 
c3; {save clipHieght} 

cl; {savesourceForm} 
c2; {save halftoneForm) 


{ {******************* debug *******************************w***} 

Li_1, c3; 

checkDebug: 

LIDisp, cl; 

BRANCH [$, normalEntry 18,0E], c2; 

L2 _primFail, GOTO [primitiveFailBitBItl], c3; 

^ *** yn*n*t ******** irii'k * * debug ***********************************} } 


{if destWidth < = 0 ORdestHeight< = 0 OR clipWidth< =0 OR dipHeight< = 0 THEN immediately Return, Nothing is done } 


normalEntry 18: 

[]_temp2Low - I.NegBr, 


c3; { check clipHeight < = 0 } 


temp2Low_uClipWidth, BRANCH [$, clipHeigbtLessO], 

[]_temp2Low - I.NegBr, 

temp3Low_uDestWidth, 8RANCH [$, clipWidthLessO], 


cl; 

c2; { check clipWidth < - 0 } 
c3; 


normal£ntry19: 

temp3Low _temp3Low - 1, NegBr, L3 __checkClip, 


cl; 


{ In Height, we check whether the area size(width*height) is greater than 64640?. If it is true, it cause a primitive fail } 
{ Q : height, temp2Low : Width, NOTE :::: temp2Low, Q, sourcelndex, tempi Low is smashed in the routine } 


otLow __ uDestHeight, 

BRANCH [{CALL} checkWidthAndHeight, destWidthLessO], c2; 

otLow__otLow - I.NegBr, c3, at [checkClip, 10. checkWidthAndHeight - return); 
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normalEntry20: 

BRANCH [$, destHeightLessO], 

otLow_uDestForm, LI_getDestFormData, 

CALL [otMap2Bank0j, 


cl; 

c2; 

c3; 


getDestination: 

MAR _ tempi Low_[templHigh, templLow + firstFieldOf Object], cl, at [getDestFormData, 10, 0tMap2BankQ - return]; 

getDestinationX: 

templLow __ tempi Low + 1, BRANCH [noPCGetDest, yesPCGetDest, 1], c2; 


yesPCGetDest: 

templLow_templLow + OFF, c3; 

MAR__ [templHigh, templLow + 0], GOTO [getDestinationX], cl; 


noPCGetDest: 

sourceindex __ MD {destination bitmap}. 


c3; { get Form BitMap Oop } 


getDestination 1: 

temp3Low __ uRumRecordLow, 

temp3High _ uRumRecordHigh, 

temp3Low_temp3Low +■ dispiayBitmapOopOffset, 


cl; 

c2; 

c3; { point the current display BitMap Oop } 


gecDestination2: 

MAR_[temp3High, temp3Low + 0], cl; 

[] sourceindex and nonPointerMask, ZeroBr, c2; { save the destination BitMap Oop } 

uDestBitMap __sourceindex, temp3Low _MD{display bitmap}, 

BRANCH [$, destinationFormNonOop], c3; { get current display BitMap Oop } 


getDestinationi: 

U _ temp3Low xor sourceindex, ZeroBr, 


cl; {dest bitmap = current display bitmap? ********} 


uCurrentDispBitMap __ temp3Low, 

BRANCH (noDestAndCurrent, yesDestAndCurrent], c2; 


{ destAddrLow = uBooleans } 
yesDestAndCurrent: 

temp3Low _ 3, c3; 

yesDestAndCurrentl; 

temp3Low _ temp3Low LRot8, cl; 

temp3Low _ temp3Low or 28, c2; { 808'd } 

uDestHeightA_temp3Low, c3; 

yesDest AndCurrent2: 

temp3Low_4, cl; 

temp3Low_temp3Low LRot8, c2; { 1024'd } 

uDestWidthA_temp3Low, c3; 

yesDest A nd Cu rrent3: 

destAddrLow _ destAddrLow + 80, cl; 

GOTO [noDe5tAndCurrent31], c2; 


noDestAndCurrent: 

tempi Low __ tempi Low + 1, { Point the Form .Width } 


c3; 


noDestAndCurrent 1: 

MAR [templHigh, templLow + 0], Li checkDestFormWidth, 

CALL [checkSmalllnt2!, 

{templLow points the Height, since it is incremented by 1 in checkSmaillnt2 routine } 
noDestAndCurrent2: 

MAR_(templHigh, templLow + 0], LI_checkDestFormHeight, 

uDestWidthA_temp2Low, CALL [checkSmaillnt2], 


cl; 

c2; 


cl, at (checkDestFormWidth, 10, check$maillnt2-return]; 
c2; 


noDestAndCurrent3: 

uDestHeightA_temp2Low, L3_checkDest, 

Q _ uDestWidthA, CALL [checkWidthAndHeight], 
noDestAndCurrent31: 

uBoofeans _ destAddrLow, GOTO [dipRangel], 


cl, at [checkDestFormHeight, 10, checkSmaillnt2 - return]; 
c 2; 

c3, at [checkDest, 10, checkWidthAndHeight - return]; 


destinationFormNonOop: 

L2_primFaii, GOTO [primitiveFai!Bit8lt2], 


cl; 


{- 

--- ClipRange - 

--- } 


{First of all, we check the X - coordinate } 
dipRangel: 

Noop, cl; 

sourceAddrLow_uSourceX, c2; 

destAddrLow_uDestX, c3; 

clipRange: 

sourceindex_uDestWidth, cl; 

temp2Low_uClipX, 12_checkXRange, c2; 
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temp3Low_uCIlpWldth, CALL (bbtCheckRangel, 

saveX: 

uSX_sourceAddrLow, 

uDX_destAddrLow, 

uW_sourcelndex, NegBr, 

checkRangeUpY: 

sourceAddrLow_uSourceY, BRANCH (widthGEO, widthLTO], 


widthGEO: 

destAddrLow __ uDestY, 
temp2Low_uClipY, 

sourcelndex _ uDestHeight, L2_cheekYRange, 

tempiLow_uClipHeight, CALL [bbtCheckRangel, 

saveY: 

uH _ sourcelndex, NegBr, LI _getSFormWH, 

uDY_destAddrLow, BRANCH [heightGEO, heightLTO], 


heightGEO: 

Xbus _ uBooleans, XDisp, 

uSY_sourceAddrLow, BRANCH (sFormNonNilO, sFormNilO, 0D|, 


sFormNonNilO: 

otLow _ uSourceForm, CALL [otMap2BankQ], 
sFormNonNilOl: 

templLow_tempILow + formHeightlndex, 

sourceAddrLow _sourceAddrLow + sourcelndex, 
sourcelndex _ sourcelndex - sourceAddrLow, 

sFormNonNH02: 

MAR (tempiHigh, tempILow +■ 0), LI checkSourceFormHeight, 

templLow __ templLow - 2, CALL [checkSmaillntJ, 
by 1 in checksmalllnt } 

sFormNonNII03: 

[]_temp2Low - sourceAddrLow, NegBr, 

{sy *■ h > sourceForm height??} 

sourcelndex_sourcelndex + temp2Low. 

BRANCH [sFormHeightGE, sFormHeightLTJ, 


sFormHeightGE: 

GOTO [checkWidth], 


sFormHeightLT: 

uH_sourcelndex, 

{ —-next; check width-} 

checkWidth: 

sourceAddrLow _ uSX, 
sourcelndex _ uW, 

sourceAddrLow _sourceAddrLow + sourcelndex, 
checkWidth 1: 

MAR_(tempiHigh, tempILow + 0], LI _checkSourceFormWidth, 
sourcelndex _ sourcelndex - sourceAddrLow, CALL (checkSmaillntJ, 

checkWidth2: 

[]_temp2Low - sourceAddrLow, NegBr, 

{ sx + w > sourceForm width ??} 

sourcelndex_sourcelndex + temp2Low, 

BRANCH [sFormWidthGE, sFormWidthLT], 


sFormWIdthGE: 

sourcelndex _ uW, GOTO (sFormNill], 


sFormWidthLT: 

uW_sourcelndex, GOTO [sf ormNil 1], 


sFormNilO: 

sourcelndex __ uW, 

^-check the h and w, if h < = 0 OR w < = 0 then return immediately 

sFormNill: 

sourceAddrLow _ uH, 

sourcelndex_sourcelndex - 1, NegBr, 

sourceAddrLow _ sourceAddrLow - 1, NegBr, BRANCH (widthGTO, wi< 

widthGTO: 

uHMI_sourceAddrLow, BRANCH [heightGTO, heightLEOj, 


heightGTO: 

LI_getMasks, GOTO [computeMask], 


c3; 

c2, at (checkXRange, 10, bbtCheck Range - return!; 
c3; 

cl; {w < 0?} 
c2; 

c3; 

cl; 

c2; 

c3; 


c2, at (checkYRange, 10, bbtCheckRange - return!; 
c3; 


cl; 

c2; 


c3; 

cl, at (getSFormWH, 10, otMap2BankO - return]; 

c2; { sy + h } 

c3; { h _ h - (sy + h)} 

cl; 

c2; { point the form width, -2 since tempILow incremented 


cl, at (checkSourceFormHeight, 10, checkSmalllnt - return]; 


c2; { h __ h + sourceForm Height } 


c3; 


c3; 


cl; 

c2; 

c3; { sx + w } 


cl; 

c2; { w _ w - (sx + w )} 


cl, at (checkSourceFormWidth, 10, checksmalllnt - return!; 


c2; 


c3; 


c3; 

c3; 

} 

cl; 

c2; { check the width = < 0 ??} 
c3; { check the height = < 0 ???} 

cl; 

c2; 


BBT.me 14-Feb-86 16:50:26 PST 


61 






widthLEO: 

CANCELBR [$, OF], 
heightLEO: 

L2 _ noTransfer, GOTO [noTransfer3], 
code } 


cl; 

c 2; { restore the Smalltalk state and execute next byte 


{- 

----compute the several kind of Mask- 

computeMask: 

Q _ 1, CALL [getSeveraiMasks], c3; { Q for the intiai value of nWords } 


} 


{ 

At return point: 

mask!, mask2, skewMask, skew and startBits have already been calculated, and been stored in uMaskl, uMask2, SkewMask, uSkew, and 
uStartBits respectively 

} 

getSeveralMasksRet: 

otLow_uW, 

getSeveralMasksRet 1: 

destAddrLow _ uStartBits. 
otLow _ otLow - destAddrLow, NegBr, 

sourceindex _ u(V!ask2. BRANCH [widthNotTooSmall, widthTooSmail], 


widthTooSmali: 

sourceindex _ sourceindex and uMaskl, 
uMaskl_sourceindex, 

uMask2 _ sourceindex xor sourceindex, 
uNWords _ Q, 

otLow _ Q, GOTO {checkOverlap], 


cl; 

c2; 

c3; {w < startBits ?? : w - startBits > 

cl; 


c2; { maskl _mask1 bitAnd: mask2 } 

c3; 

cl; { mask2 _0 } 

c2; { uNWords _ 0{ 1 >. because of 0 origin } 
c3; 


widthNotTooSmall: 

otLow _ otLow - 1, NegBr, c2; 

otLow _ otLow and -OF, BRANCH (noNegative, yesNegatlve], c3; 


yesNegative: 

otLow_otLow xor '-otLow, GOTO (noNegative 1], 


cl; { make otLow - 1} 


noNegative: 

otLow_otLow LRot12, 

noNegative 1: 

otLow_otLow + 2, 

uNWords __ otLow, GOTO [checkOverlap], 


cl; { (w - startBits - 1//16) 

c2; {{w - startBits - 1//16 + 2 } 
c3; { save nWords } 




CheckOverlap 


checkOverlap; 

NOOp, 

OtLOW_OtLow - Q, 

uNWordsMI _ OtLow, 


> 


cl; 

c2; {decrement} 
c3; 


checkOverlapI: 

uStackF _ otLow, 
uVDir _ Q, 

uHDlr __ Q, L2 _ getDestBits, 


cl; 

c2; { default v-direction = 1} 
c3; { default h - direction = 1 } 


checkOverlap2; 

tempi Low _ uSourceForm, 
destAddrLow _ uDY, 
sourceAddrLow_uSY, 


cl; 

c2; 

c3; 


checkOveriap3: 

[] _ tempi Low xor uDestForm, ZeroBr, 


cl; { sourceForm = = destFrom ??} 


[]_destAddrLow - sourceAddrLow, NegBr, 

BRANCH [sameOopNo, sameOopYes], c2; { dy > * sy ?? > 


sameOopYes: 

[J _ sourceAddrLow xor destAddrLow, ZeroBr, BRANCH (dyGE, dyLTj, 


c3; { dy = sy ??} 


dyGE: 

sourceindex _ uHM 1, BRANCH [dyGT, dyEQ], 


cl; { sourceindex __ h - 1} 


{sourceForm = = destForm and dy > sy} 
dyGT: 

uVDir_temp2Low xor ~temp2Low, 

destAddrLow _ destAddrLow + sourceindex. 


c2; { vOir_- 1 } 

c3; { dy_dy + h - 1} 
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dyGTI: 

sourceAddrLow_sourceAddrLow + sourcelndex, 

uDY_destAddrLow, 

uSY_sourceAddrLow, GOTO [dyLT], 


cl; { sy _$y + h - 1 } 

c 2; 

c3; 


{sourceForm = =destForm and dy =sy} 
dyEQ: 

sourceAddrLow _ uSX, c2; 

destAddrLow uDX, <3; 


dyEQI: 

[]_sourceAddrLow - destAddrLow, NegBr, cl; { dx > sx ??} 

uHDlr_temp2Low xor —temp2Low, BRANCH [dxLE, dxGT], c2; { hDir_- 1 : So far default} 


{ sourceForm = = destForm and dy = sy and dx >$x } 
dxGT: 

sourcelndex_uW, c3; 


sourcelndex __sourcelndex - 1, cl; 

sourceAddrLow_sourceAddrLow + sourcelndex, c2; { sx_sx + w - 1} 

destAddrLow _ destAddrLow + sourcelndex, c3; {dx_dx + w - 1} 


dxGTI: 

otlow _ uSkewMask, 

uSkewMask_-otLow, 

tempi Low_uMaskl, 

dxGT2: 

?emp2Low _ uMask2, 

uMaskl _temp2Low, 

uMask2 _ tempi Low, 

dxGT3: 

uDX __ destAddrLow, 
uSX_sourceAddrLow, 


cl; 

c2; { skewMask bitlnvert } 
c3; 


cl; 

c2; 

c3; {exchange maskl and mask2} 


cl; 

c2: { savesx } 


sameOopNo: 

CANCELBR (dyLT, 1|, 


c3; 


dxLEi: 

uHDir _ Q, GOTO [dyLT], 


c3; 


dyLT: 

CANCELBR [$, 1], 


cl; 


{ --- 

--calculate Offsets 


> 


calculateOffset: 

otLow _ uDestBitMap, CALL [getSTFormMapBasel], c2; 

{ at return 

tempi High, tempi Low : map base 

temp2Low ; word no. per 1 horizontal line < destRaster) 

otLow: Oopfor bitmap 

} 

calculateOffsetl: 

destAddrLow __ tempi Low, L2 _getDestMul, c2, at [getDestBits, 10, getSTFormMapBase - return]; 

Q_uDY, CALL [bbtMultiply], c3; { destlndex_dy*destRaster: Q_Q*temp2Low } 

{ destAddrLow Points the actual destination Address. Now, we calculate the destDelta } 
destAddrLow __ destAddrLow + Q, 
sourcelndex_uDX, 

getDestAddrl: 

sourcelndex _ sourcelndex and ~0F, 
sourcelndex __sourcelndex LRot12, 
destAddrLow _ destAddrLow + sourcelndex, 

getDestAddr2: 

tempi Low _ tempi High, 
destAddrHigh _ tempi Low LRotO, 

Xbus_uVDir, XHDisp, 

checkDir: 

Xbus _ uHDir, XHDisp, BRANCH [vPI, vMI, 2], 


c2, at [getOestMul, 10, bbtMultiply - return]; 

c3; 


cl; 

c2; 

c3; { destlndex _ destRaster*dy +<dx//l6)> 


cl; 

c2;{ save the destination High address } 
c3; 


cl; 


vPI; 

sourcelndex _uNWords, BRANCH (vPlhPI, vPlhMI, 2], 


c2;{5ave the destination Map to check} 


vPlhPt: 

temp2Low _temp2Low - sourcelndex, L2 __ getSourceBits, 
GOTO [saveDestDelta 1 ], 


c3; { destDelta_destRaster * 1 - nWords * 1 } 


vPlhMI: 
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temp2Low _ temp2Low + sourcelndex, L2 _ getSourceBits, 

GOTO (saveDestDelta 1], 

vMI: 

sourcelndex_uNWords, BRANCH (vMIhPI, vMlhM 1,2), 

vMIhPI: 

temp2Low_- temp2Low, 

temp2Low _ temp2Low - sourcelndex { - 1}, GOTO [saveDestDelta], 

vMIhMI: 

temp2Low _ sourcelndex - temp2Low, GOTO (saveDestDelta 1 j. 


c3; { destDealta __destRaster*l - nWord$*(-1)} 

c2; 

c3; 

cl; { destDelta_destRaster*(-1) - nWords*1} 

c3; {destDelta _ destRaster*( - I) - nWords*(~ 1)} 


saveDestDelta 1: 

Noop, cl; 

saveDestDelta: 

uDestDelta __ temp2Low, L2 __ getSourceBits, c2; 

{ Next we check the sourceform > 

getSformAddr: 

tempi Low _ uBooleans, X Disp, c3; 

otLow_uSourceForm, 

BRANCH ({CALL} getSTFormMapBase,saveBooleans,ODf, cl; { default preload = False, so uBooleans. 15 « 0} 


{ at return 

tempi High, Low : source MapBase 

iemp2Low : Word no of 1 horizontal line (sourceRaster) 

otLow : Oop for BitMap 

} 

getSFormAddrl: 

sourceAddrLow __ tempi Low, L2_getSourceMul, 

Q _ uSY, CALL [bbtMultiply], 

{ sourceAddrLow points the actual source address } 
sourceAddrLow _ sourceAddrLow + Q, 

Q _ temp I High, 

getSourceAddr: 

sourceAddrHigh _ Q LRotO, 

sourcelndex_uSX, 

tempi Low _ sourcelndex and -OF, 

tempILow_tempILow LRot12, 

Q_skew, ZeroBr, 

sourceAddrLow_sourceAddrLow +■ tempILow, 

BRANCH (skewNonZero3, skewZero3], 


skewNonZero3: 

sourcelndex _ sourcelndex and OF, 
skewNonZero4: 

(]_ sourcelndex - Q, NegBr, 

tempILow_uBooleans, BRANCH (skewLEI, skewGTI], 


c2, at [getSourceBits, 10, getSTFormMapBase - return]; 
c3; { sourcelndex __ sy*sourceRaster: Q_Q*temp2Low } 


c2, at {getSourceMul, 10, bbtMultiply - return]; 
c3; 


cl; { save high source address } 

c2; 

c3; 

cl; 

c2; 

c3;{ sourcelndex __ sourceRaster*sy + (sx//16)} 


cl; { sx bitAnd: 15 } 

c2; {skew < = (sxbitAnd: 15)} 
c3; 


skewLEI: 

tempILow_tempILow or 1, GOTO [checkhDir], 

skewGTI: 

GOTO (checkhDir], 

skewZero3: 

tempILow _ uBooleans, GOTO [checkhDir], 


cl; { preload = True } 


cl; { preload = False } 


cl; 


{ Now, temp2Low still has the sourceRaster } 
checkhDir: 

Q uHDir, XHDisp, c2; 

[]_ tempILow, YDisp, BRANCH [hP1,hM1,2], c3; 


sourcelndex _ uNWords, 

BRANCH (hPlPreFalse, hPIPreTrue, 0E], 


cl; 


hPlPreFalse: 

sourcelndex __ sourcelndex, GOTO [checkVDirl], 


c2; { nWords + 0*1 : preload = False, hDir = 1 } 


hPIPreTrue: 

sourcelndex_sourcelndex + 1, GOTO (checkVDirl], 


c2; { nWords + 1*1 : preload = True, hDir = 1 } 


hMI: 


sourcelndex_uNWords, 

BRANCH [hM 1 PreFalse, hM 1 PreTrue, 0E], 


cl; 
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{ 


— — Now, hDir < 0 ifTrue: [preload_preload = = false] 

— — so, preloadFalse actually means preload = True, preloadTrue vice versa, 

- - .) 


hMIPreFalse: 

sourcelndex __0 - sourcelndex - 1 , 

tempi Low tempi Low or 1 , GOTO [checkVDir2], 


c2; {nWords + 1*(- 1): preload = False, hDir = - 1 > 
c3; { make preload = True } 


hMiPreTrue: 

sourcelndex_0 - sourcelndex , 

tempi Low _ tempILow and OE, GOTO [checkVDir2], 


c2; {nWords + 0*(- 1): preload = Trued, hDir = - 1 } 
c3; { make preload = False } 


checkVDirl: 

Noop, c3; 

checl<VDlr2: 

Xbus __ uVDir, XHDisp, 

Q_ - temp2Low, BRANCH (vDirPI, vDirMI, 2], 


cl; 

c2; { Q __ - sourceRaster > 


vDirPI: 

{ sourceRaster* 1 - (nWords +• (preload ifTrue: [IJifFalse: [0])*hDir)> 

temp2Low _ temp2Low - sourcelndex, c3; 

uSourceDelta _ temp2Low, GOTO [saveBooleans], cl; 


vDirMI: 

{sourceRaster*{- 1) - (nWords + (preload ifTrue: [1] if False: (Oj)*hDir)} 

Q_Q - sourcelndex, c3; 

uSourceDelta _Q, cl; 

saveBooleans: 

uBooleans._ tempi Low, YDisp, LI _ getHalftoneBits, c2; 

{ now Get the halftone Form address } 

otLow _ uHalftoneForm, BRANCH [{CALL} otMap2BankO, hFormNi!21, OBI, c3; 


getHalftone: 

MAR __ tempILow _ [templHigh, tempILow + formMapBaselndexJ, cl, at (getHalftoneBits, 10, otMap28ankO - return]; 

getHalftoneAddr: 

BRANCH [noPCGetHalftone, yesPCGetHaiftone, 1], c2; 


yesPCGetHalftone: 

tempILow __ tempILow + OFF + 1, c3; 

MAR_[temp 1 High, temp 1 Low + 0|, GOTO [getHalftoneAddr], cl; 

noPCGetHalftone: 

otLow_MD,L1 _getHalftoneBits1, c3; 

[]_otLow and nonPointerMask, ZeroBr, cl; 

BRANCH [S, hBitMapNoOop], c2; 

CALL [otMap2BankO], c3; 


hFormNi!21: 

GOTO [startVLoop], cl; 


hFormNil2: 

tempILow_tempILow + firstFieldOfObject, cl, at [getHalftoneBitsI, 10, otMap2BankO - returnl; 


{ - 

-- -■ Register Usage: RO — > 

RH1, R1 

RH2, R2 

RH3 - - > 

R3 - - > 

RH5, R5 - - > 


(sourcelndex) 

— > Addressof destination Bits 

— > Address of sourceBits 

**** High Addressof OT ****” 

Destination! ndex 

Address of halftoneBits 


(destAddrHigh, sourceAddrLow) 
(sourceAddrHigh, sourceAddrLow) 
(destlndex) 

(HalftoneAddrHigh, HalftoneAddrLow) 


{ 


Start of Vertical Loop 


> 

startVLoop: 

Xbus _ uBooleans, XDisp, L2_bbtCheckMInt, 

startVLoop!: 

LI _ 0, Q _ uHDir, DISP4 [vLoop], 


c 2; 
c3; 


{ —-skew#0, HForm = SForm = -nil. Preload = FALSE-} 

startVLoopOO: 

sourcelndex _ uVDir, CALL [getHaiftoneWord], cl, at [00,10, vLoop]; 


BBT.me 14-Feb-86 16:50:26 PST 


10 















startVLoop002: 

temp3Low __ uNWordsMI, L2 _skewWord, c2, at (00,10, getHalftoneWord - return); 

StartVLoopOOl: 

otLow __ uMaskl, c3; 


sourcelndex __ sourcelndex xor sourcetndex. 
Noop, 

CALL [calSkewWord], 

MAR _ [destAddrHigh, destAddrLow + 0], 
temp2Low _temp2Low and uHalftoneWord, 
sourcelndex_MD, 

L2_bbtCheckMInt, 

Xbus_uCombinationRule, XDisp, 

Q __ uHDlr, DISP4 [combOD], 


cl; 

c2; 

c3; 

cl, at (skewWord, 10, calSkewWord - return}; 

c2; 

c3; 

cl; 

c2; 

c3; 


{ —-skew < >0, HForm = -nil, SForm = -nil, Preload = TRUE-} 

startVLoopOl: 

sourcelndex _ uVDir, CALL [getHalftoneWord], cl, at (01, 10, vloop]; 


startVLoopOl 1: 

temp3Low _ uNWordsM 1, 
otLow __ uMaskl, 


c2, at (01,10, getHalftoneWord - return]; 
c3; 


MAR_(sourceAddrHigh, sourceAddrLow + 0], cl; 

sourceAddrLow __ sourceAddrLow + Q, L2 __ skewWord, c2; 

sourcelndex _ MD, CALL [calSkewWord], c3; 


{ - --skew < >0, HForm = -nil, SForm-nil. Preloads: FALSE **-> 

start VLoop02: 

sourcelndex _ uVDir, CALL [getHalftoneWord], cl, at (02,10, vLoop]; 

temp3Low _ uNWordsMI, GOTO (startVLoopOAl], c2, at [02, 10,getHalftoneWord - return]; 


{—-skew< >0, HForm = -nil, SForm = nil. Preload = TRUE--INVALID -} 

startVLoop03: 

GOTO (iteration!, cl, at (03,10, vLoopj; 


{ --skew < > 0, HForm = nil, SForm = -nil, Preload = FALSE-} 

startVLoop04: 

temp2Low uHalftoneWord temp2Low xor ~temp2Low, cl, at [04,10, vLoopj; 

temp3Low uNWordsMI, L2 skewWord, GOTO [startVLoopOOl|, c2; 


{ - -skew < >0, HForm = nil, SForm = -nil, Preload = TRUE-- — } 

startVLoop05: 

uHalftoneWord_temp2Low xor — temp2Low, GOTO [startVLoopOII], cl, at [05,10, vLoopj; 


{ --skew < >0, HForm = nil, SForm = nil. Preload = FALSE **-} 

startVLoop06: 

temp2Low __ uHalftoneWord_temp2Low xor ~temp2Low, 

GOTO [startVLoopOEl], cl, at (06, 10, vLoopj; 


{-skew< >0, HForm = nil, SForm = nil. Preload =>TRUE-INVALID -} 

startVLoopG7: 

GOTO [iteration}, cl,at(07, 10, vLoop]; 


{-skew = 0, HForm = —nil, SForm * —nil. Preload = FALSE-} 

startVLoop08: 

sourcelndex_uVDir, CALL [getHalftoneWord], cl, at [08,10, vLoopj; 


otLow_uMaskl, 

startVLoopG81: 

temp3Low _ uNWordsM 1, 


c2, at [08, 10, getHalftoneWord - return]; 
c3; 


MAR _[destAddrHigh, destAddrLow + 0], cl; 

Xbus_uCombinationRule, XDisp, c2; 

sourcelndex _ MD, L3 _ 0, DISP4 [combOC], c3; 


{ --skew - 0, HForm = -nil, SForm - -nil. Preload = TRUE-INVALID -} 

startVLoopQ9: 

GOTO [iteration], cl, at [09,10, vLoop]; 


{ --skew = 0, HForm = -nil, SForm = nil, Preload = FALSE-} 

startVLoopOA: 

sourcetndex_uVDir, CALL [getHalftoneWord], cl, at [0A, 10. vLoop]; 


temp3Low uNWordsM 1, 

startVLoopOAl: 

otLow_uMaskl, 


c2, at (0A, 10, getHalftoneWord - return]; 
c3; 


MAR (destAddrHigh, destAddrLow + 01, cl; 

Xbus uCombinationRule, XDisp, c2; 

sourcelndex __ MD, L3 _ 0, DISP4 [combOE], c3; 
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{-skew = 0, HForm = -nil, SForm = nil. Preload = TRUE-INVALID -} 

startVLoopOB: 

GOTO [iteration], cl, at [OB, 10, vLoop]; 


{-skew = 0, HForm = nil, SForm = -nil. Preload = FALSE--} 

startVLoopOC: 

temp2Low_uHalftoneWord_temp2Low xor -temp2Low, cl, at [0C, 10, vLoop]; 

otLow __ uMaskl, GOTO [startVLoop081], c2; 


{-skew = 0, HForm - nil, SForm =* -nil. Preload = TRUE-INVALID -} 

startVLoopOD: 

GOTO [iteration], cl, at [0D, 10, vLoop]; 


{-skew = 0, HForm = nil, SForm = nil. Preload = FALSE-> 

startVLoopOE: 

temp2Low_uHalftoneWord_temp2Low xor -temp2Low, cl, at [0E, 10, vLoopj; 

startVLoopOE 1: 

temp3Low _ uNWordsM 1, GOTO [startVLoopOAl], c2; 


{-skew =s 0, HForm = nil, SForm = nil. Preload = TRUE- INVALID-} 

startVLoopOF: 

Noop, cl, at [OF, 10, vLoop]; 

iteration: 

Noop, c 2 ; 

GOTO [startVLoopOF], c3; 


{ 


Start of Horizontal Loop 



sourceAddrHigh, sourceAddrLow 


(RH2, R2) 

_ 


destAddrHigh, destAddrLow 


(RH1.R1) 

— 

----- 

tempi High, tempi Low(Haiftone Form) 


(RH4, R4) 

— 

— - - 

temp2Low : prevWord 

(R5) 


— 

— — 

sourcelndex : skewWord 

(R0> 


— 


sxew : 

(RH0) 


— 

— — 

temo3Low : loooconter(word) 

<R6) 


— 

— .. - 

otLow ; maskl(mergeMask) 

(R3) 


— 


{ 


no Mesa interrupt 


reentryBitblt: 

destAddrLow _ destAddrLow + temp3Low, LIDisp, 

BRANCH (sFormNonNilMIntCheck, sFormNilMIntCheck, 0D], 


} 


c2, at [bbtCheckMInt, 10, noMesalnterrupt-return]; 


sFormNilMIntCheck: 

Q_uHDir, DISP4 [vLoop], 


c3; { update destAddr} 


sForrnNonNi IM IntCheck: 

Q _ uSourceDelta, CANCELBR [$, OF], c3; 

sourceAddrLow _ sourceAddrLow + Q, cl; 

LIDisp, GOTO [sFormNilMIntCheck], c2; 


{ 


—-Mesa Interrupt —- 

--- } 

{save the bitBIt parameters into the mesa stack, and restore Smalltalk ip, stackp, home 


temp2Low = OF , this value is store in checkMesalnterrupt} 
mesalntlnBitblt: 

uDestAddrLow_destAddrLow, 

mesalntlnBitbltl: 

destAddrLow __ destAddrHigh, stackP _ temp2Low, 

sourcelndex_uCombinationRule, 

sourcelndex __ sourcelndex LRot8, 

destAddrLow __ destAddrLow or sourcelndex, 

uDestAddrHIgh_destAddrLow, 

sourcelndex_uDY, 

mesalntlnBitblt2: 

sourcelndex ___ sourcelndex and temp2Low, 

sourcelndex_sourcelndex LRot4, 

Q __ skew, 

mesalntlnBltblt3: 

sourcelndex __ sourcelndex or Q, 
sourcelndex __ sourcelndex LRotS, 
temp2LowuBooleans, XDisp, 


mesalntlnBitblt4: 


c3, at [bbtCheckMInt, 10, mesainterrupt-returnl; 


cl; 

c2; 

c3; 

cl; 

c2; {save highaddr of dest and combination Rule > 
c3; 


cl; {08-0B: dy'soffset} 

c2; 

c3; 


cl; {00 -03: dy's offset, 04-07: skew} 

c2; 

c3; 
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-atus-return); 


3ank0-return); 


illlnt - return]; { size 
sect} 


ursorbitmap} 



temp2Low_temp2Low and OF, DISP4 (shForm, 9], 

cl; 


{halftone = nil, source- = nil} 



uSourceAddrLow sourceAddrLow, 

c2, at [0D, 10, shForm]; { sourceAddrLow } 


sourceAddrLow_sourceAddrHigh, 

c3; 


sourceAddrLow sourceAddrLow LRot8, 

cl; 


uSaveHighAddr sourceAddrLow, 

c2; {00 -07: sourceAddrHigh } 


saveDelta: 



tempi Low _ uSourceDeita, 

c3; 


tempi Low_tempi Low and OFF, GOTO [bothNii], 

cl; 


{halftone- = nil, source = nil} 



uHalftoneAddrLow tempi Low, 

c2, at (OB, 10, shForm]; 


tempi Low_tempi High, 

c3; 


uSaveHighAddr _ tempi Low, GOTO [bothNii], 

cl; {08-OF: halftoneAddrHigh} 


{halftone- = nil, source- = nil} 



uHalftoneAddrLow tempi Low, 

c2, at [9,10, shForm]; {save halftoneAddrLw } 


Q_tempi High, 

c3; 


uSourceAddrLow sourceAddrLow, 

cl; {saevesourceAddrLow} 


sourceAddrLow sourceAddrHigh, 

c2; 


sourceAddrLow _ sourceAddrLow LRot8, 

c3; 


Q _ Q or sourceAddrLow, 

cl; {00 -07:sourceAddrHigh,08-OF:halftoneAddrHigh} 


uSaveHighAddr_Q, GOTO [saveDelta], 

c2; 


{halftones nil, source = nil} 
bothNii: 



tempdLow uDestDelta, 

c2, at [OF, 10, shFormj; 


temp3Low _temp3Low and OFF, 

c3; 


tern pi Low __ tempi Low LRot8, 

cl; 


templLow _ templLow or temp3Low, 

c2; 


uDestDelta_templLow, 

c3; {00 -07:sourceDelta,08-OF: destDelta} 


saveDirection: 



Xbus uHDir, XHDisp, 

cl; 


Xbus _ uVDir, XHDisp, BRANCH [hDirPlusSave, hDirMinusSave, 2], 

c2; 


hDirPlusSave: 



BRANCH [vDirPfusSave, vDirMinusSave, 2], 

c3; 


vDirMiriusSave: 



temp2Low_temp2Low or 40, GOTO [saveMIsc], 

cl; {vDir = - 1} 


hDirA/linusSave: 



temp2Low _ temp2Low or 20, BRANCH [vDirPiusSave, vDIrMinusSave, 2], 

c3; {hDir = - 1} 


vDirPlusSave: 



Noop, 

cl; 


saveMIsc: 

{00-03: dy'soffset,04-07:skew,09:vDir = - l,0A:hDir= -1,0C-0F: booleans} 



sourcefndex sourcelndex or temp2Low, L2 bitbltNotFinished, 

c2; 


uMisc _ sourcelndex, CALL [restoreStatus], 

c3; 


LODisp, 

c3, at [bitbltNotFinished, 10, restoreStatus - return]; 


XC2npcDisp, DISP2 [IpAjustlnBBT], 

cl; 


CANCELBR [IpAjustedlnBBT, OF], 

c2, at [0,4, ipAjustln8BT]; 


ipAjustedlnBBT: 



templLow _0, GOTO [saveSmalltalkStateBankO], 

c3; 


tempi Low_0, BRANCH [pci OOne, pc16Zero, 0E], 

c2, at [1,4, ipAjustlnBBT]; 


pc160ne: 



Cin __pc16, GOTO [saveSmalltalkStateBankO], 

c3; 


pcl6Zero: 



ipLow_ipLow - 1,Cin_pcl6, GOTO [saveSmalltalkStateBankO], 

c3; 


ipLow_ipLow - 1, CANCELBR [ipA|ustedlnBBT, OF], 

C2, at [2,4, ipAjustlnBBT]; 


templLow _0, BRANCH [pcl60ne1, pcl6Zeroi, OE], 

c2, at [3,4, ipAjustlnBBT); 


pcl60nel: 



ipLow _ ipLow - 1, Cin _pcl6, GOTO [saveSmalltalkStateBankO], 

c3; 
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pdfiZerol: 

ipLow_ipLow - 2,Cin_pcl6, GOTO [saveSmalltalkStateBankOl, 


c3; 


aliFinished: 

temp2High _ uRumRecordHigh, 
aliFinished 1: 

temp2Low_uRumRecordLow, 

al!Finished3: 

temp2Low _temp2Low +• cursorBitmapOopOffset, 

1.2 _ bitbltFlnished, 

stackP_1, CALL [restoreStatus], 

otlow_uDestBitMap, 

MAR __ [temp2High, temp2Low + 01, 

LI_getCursorMap, 

Q_MD, 

(3_Q xor otlow, ZeroBr, 

BRANCH (noCurrentCursor, yesCurrentCursor], 


c 2; 


c3; 


cl; 

c2; 

c3; { restore the Mesa stack Pointer > 

c3, at (bitbltFinished, 10, restoreStatus - return]; 

cl; 

c2; 

c3; { get current cursor map } 

cl; 

c2; 


yesCurrentCursor: 

temp3High_CSBforCursorHigh, CALL [otMap2BankO], 

yesCurrentCursor 1; 

temp I Low __ tempi Low + sizeFieldOffset, 
temp3Low _ CSBforCursorLow, 

Q_10, 

MAR _(temp1 High, tempi Low + 0], LI_cursorWidtht, 

CALL [checkSmalllnt), 

[] __ temp2Low {size} - Q, NegBr, 

16 ??} 

tempi Low __ tempi Low + 1, BRANCH (sizeGEI Ox, sizeLTl Ox], 


c3; 


cl, at (getCursorMap, 10, otMap2BankO - return]; 

c2; 

c3; 

cl; 

c2; 

cl, at [cursorWidthl, 10, checkSmalllnt - return]; { size < 
c2; { point the first (??) field of object} 


sizeGEI Ox: 

temp2Low _ 11, GOTO (restoreCursorPattern], 


c3; { loopocunt = 16'd} 


sizeLTl Ox: 

temp2Low_temp2Low + 1, 


c3; {loop count = size of currentcursorbitmap} 


restoreCursorPattern: 

temp2Low _temp2Low - 1,ZeroBr, cl; 

BRANCH [continueRestoreCursor,endRe$toreCur$or], c2; 


conti nueRestoreCursor: 
Noop, 


c3; 


MAR _ [temp3High, temp3Low + 0], 
temp3Low_temp3Low + 1, 

Q_MD, 


cl; 

c2; 

c3; { get current pattern } 


MAR _ [tempi High, tempi Low + 0], 

MDR_Q, 

tempi Low _ tempi Low + 1, GOTO [restoreCursorPattern], 


cl; 

c2; { save current pattern to ...} 
c3; 


endRestoreCursor: 

GOTO [nextByteCodelnBankO], 


c3; 


noCurrentCursor: 

GOTO [nextByteCodelnBankO], c3; 

{the receiver returns itself, so there is no need for Smalltalk stack clean up} 


{- 

destWidthLessO: 

GOTO [noTransferlj, 


} 


c3; 


destHelghtLessO: 

L2_noTransfer, GOTO [noTransfer3], 


c2; 


clipWidthLessO: 

GOTO [noTransfer2], 


cl; 


cfipHelghtLessO: 

L2 __ noTransfer, GOTO [noTran$fer3], 


c2; 


widthLT0: 

GOTO [noTransfer 1], 


c3; 
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heightLTO: 


GOTO [noTransfer2], 


noTransfer 1: 

12 _ noTransfer, 


noTransfer2: 

L2_noTransfer, 


noTran$fer3: 

CALL [restoreStatus], 


GOTO [nextByteCodelnBankO], 


hBitMapNoOop: 

L2_primFail, GOTO [primitiveFailBitBltl], 


halftoneFormlnval id: 

L2 _ primFail, GOTO [primitiveFail8itBlt3], 


destFormlnvaiid: 

L2_primFail, GOTO [primitiveFailBitBlt31, 


sourceFormlnvalid: 

L2_primFail, GOTO [primitiveFailBitBlt3], 


primitiveFailBitBltl: 

Noop, 

primitiveFailBitBlt2: 

Noop, 

primitiveFailBitBlt3: 

stackP_1, CALL (restoreStatusj, 

tempi Low __ 2, GOTO [saveSmalltalkStateBankO], 


desti nationNonOop: 

CANCELBR ($, 1], 
sourceNonOop: 

CANCELBR [$, 1j, 
halftoneNonOop: 

L2 _ primFail, CANCELBR (primitiveFailBitBltl, 1}, 


combinationRuleTooBig: 

L2_primFail, GOTO [primitiveFailBitBltl], 


d; 


c2; 


c3; 


c3. at [noTransfer, 10, restoreStatus - return]; 


c3; 


c2; 


c2; 


cl; 
c 2; 
c 3; 

c3, at [primFail, 10, restoreStatus - return]; 


cl; 

c2; 

c3; 


c3; 


{ Edit history; 


22 - Jan - 86 15:55:22 
20 - Jan - 86 10:31:02 
when Mint occur. 

27-Dec-85 14:35:33 
7 - Nov - 85 18:48:48 
16 - Oct -85 16:59:32 
16 - Oct -85 16:34:22 
30 - Sep - 85 15:56:37 
27-Sep-85 16:34:57 
27 - Sep - 85 14:00:35 
27-Sep-85 13:59:42 
13-Sep-85 13:28:45 
primitiveCopyBits and remove 
20-iun-85 9:53:33 


Tokunaga 

Tokunaga 

Tokunaga 

Tokunaga 

Sakakibara 

Sakakibara 

Sakakibara 

Sakakibara 

Sakakibara 

Matsumoto 

Tokunaga 

calling updateCursor. 
Tokunaga 


for stretched 

exchange uDestBitMap and uCombinationRule, and modify the save and restore ConbinationRule value 

refine the routine concerning with saving and restoring copyBits status when mesa Int occur 
modify the routine for getting the actual address of BitMap Object (calculateOffset) 
change usource 

change several points (by Tokunaga) 

Fix tempi Low value at noPCarryC 
Added combinationRule= 16 check 
Bug fix PrimitiveFaii 
Add CANCELBR Mask 

Add the adjustment for Smalltalk instruction pointer when Mesa Int occur during 
remove checkSmalllnt to bbtsubs.mc > 
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{ BBTSubs.mc 

Subroutines for SitBIt primitive for Rum, the Dandelion Smalltalk - 80 microcoded virtual machine, 
by TTokunanga, M Sakakibara, J Trow 
10-Feb-86 20:07:45 

Copyright 1985,1986 by Xerox Corporation. All rights reserved. } 


{ checkSmalllnt 

Test MD and convert it to a binary number if it is a Smalllnteger. Fail if it is not a Smaillnteger. 

input: MD is object to be tested 

LI is the return link 

output: temp2Low is the converted binary value 
tempi Low is incremented 

smash: } 


checkSmalllnt: 

temp2Low MD, XHDisp, c3 

(] _ temp2Low and nonPointerMask, ZeroBr, 

BRANCH [posSmalllnteger, negSmallinteger, 2], cl 


posSmallinteger: 

temp2Low_RRotl temp2Low, BRANCH (oops, notOopsj, 


c2 


negSmallinteger: 

temp2Low _ RRotl {temp2Low or 3), BRANCH [oops, notOopsj, 


c2 


notOops: 


temp2Low_RRotl temp2Low, 

c3 

Noop, 

cl 

tempILow _ tempILow + I.LIDisp, 

c2 

RET (checkSmailint - return}. 

c3 

L2 __ primFail, GOTO (primitiveFailBitBItl j. 

c3 


{checkSmalllnt2: *************** stretched **************** 
subroutine for checking smallinteger & convert to normal integer 
At entry: c3 
At Return : cl 
Link register: LI 
to be checked : temp2low 
result: temp2Low 

Note: tempILow is incremented. 

> 

chec!<Smaillnt2: 

temp2Low MD, XHDisp, c3 

checl<Smalllnt2c1: 

[]_temp2Low and nonPointerMask, ZeroBr, 

BRANCH [posSmalllnteger2, negSmaiilnteger2,2], cl 


posSmalllnteger2: 

temp2Low _ RRotl temp2Low, BRANCH (oops2, notOops2j, 


c2 


negSmalllnteger2: 

temp2Low _ RRotl (temp2Low or 3), BRANCH (oops2, notOops2], 


c2 


notOops2: 


temp2Low_RRotl temp2Low, 

c3 

Noop, 

cl 

tempILow _tempILow + l.LIDisp, 

c2 

RET [checkSmailint2 - return]. 

c3 


oops2: 

L2 __ primFail, GOTO (primitiveFailBitBItl ], 


c3 


8BTSubs.mc 10-Feb-86 20:07:48 PST 



{ 


--ex: maskl_RightMasksat: startBlts +1- 

Entry point: c2, c3 Exit point: c3 

the argument is stored in temp3Low , if it isn't between 0 and 10‘X then primitiveFail. 
Return link: L3 
Result: temp2Low } 
makeRightMasks: 

Noop, 

makeRlghtMasks3: 

temp2Low _ temp2Low xor temp2Low, 

{ argument is between 0 and 10‘X > 
argOKInBBT: 

temp3Low _temp3low - 1,NegBr, 

L3Disp, BRANCH (shiftLoop, shiftEnd], 


c2; 


c3; 


cl; {decrement the shift counter} 
c2; 


shiftLoop: 

temp2Low_temp2Low LShiftl.SE _ 1, CANCELBR [argOKInBBT, OFl, 


c3; 


shiftEnd: 

RET [makeRightMasks - return]. 


c3; 


{ This routine is for checking Mesalnterrupt, ST80 BitBIt use this routine. } 

( 

return link : L2 

No Interrupt Exit point: return cycle = cl, pending Xdipatch by uBooleans 
temp3Low : DestDelta 
interrupt Exit point: c2} 


PC: MesaStatePC, 

pc 16 : MesaStatePC 16 (pci6 - Bit.15) 
rhPC : MesaStateRhPC 
IBptr: MesaStatelBPtr 
IB : Mesa State! B 

uPPCross: 0 — > no Cross 

— > Cross 

UvChigh : high Address bot od code segment 
UvPCpage: virtual page No of current mesa code 


{register definition } 

RegDef [MesaStatePC, U, 50]; 

RegDef (MesaStatelBPtr, U, 53]; 

RegDef [MesaStatelB, U, 54]; 

RegDef {MesaStateRhPC, U, 51]; 

checkMesalnterrupt: 

temp2low __0F, MesalntBr, cl;{u$ing if mesa interrupt occur as a stack value} 

checxuWP: 

temp3Low_uWakeupPending, ZeroBr, 

BRANCH [bitBltNolnterrupt, maybelnterrupt], c2; 


bitBItNointerrupt: 

temp3Low _ uDestDeita, L2Disp, CANCELBR [nolnterrupt, 1 ], c3; 


maybelnterrupt: 

temp3Low _ uDestDeita, L2Disp, BRANCH [bitBitlnterrupt, nolnterrupt], c3; 


nolnterrupt: 

Xbus _ uBooleans, XDisp, RET [noMesalnterrupt - return]. 


cl; 


bitBitlnterrupt: 

temp3Low _ MesaStatePC, CANCELBR [%, OF], cl; 

temp3Low _ temp3Low -1, c2; 

temp3High _ MesaStateRhPC, c3; 

bitBltNoCross: 

MAR _ [temp3High, temp3Low + 0], Xbus_MesaStatelBPtr, XDisp, cl; 

MesaStatePC _ temp3Low, DISP4 [bitBltRestorelB, 0C], c2; 


{Empty} Noop, GOTO [ciearCrossindlcator], 

{Byte} temp3Low _MD, GOTO [ciearCrossindicatorj, 
{Full} GOTO [bitBltNoCross], 

{Word} temp3Low _ MD, GOTO [ciearCrossindlcator], 


c3, at (0C, 10, bitBltRestorelB]; 

c3, at (OD, 10, bitBltRestorelB]; 

c3, at [OE, 10, bitBltRestorelB]; {forever iteration} 

c3, at [OF, 10, bitBltRestorelB]; 


{there is no check for pcl6, bacause 1 or 2 bytesare stored into IB from MesaStatelB coressponding to the po16 respectively in 
I n it And M esa StateSaveA nd Restore. me} 
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clearCrossindicator: 

uPCCros$_destAddrLowxordestAddrLow, L2Disp, c1;{uPPCross_0> 

MesaStateiB _ temp3Low, RET [mesalnterrupt - return), c2; 


Subroutine : getSTFormMapBase 

Eintry : otLow = Form Oop (getSTFormMapBase)-SourceForm 

otLow = Form BitMap Oop (getSTFormMapBase 1)-OestForm 

L2 : returnLink 

Exit : tempiHigh, templLow has the map base 
otLow : Oop for bitmap 
temp2Low : the Words No. for 1 horizontal line, 


cycle: Entry cl. Exit cl 

> 

getSTFormMapBase 1: { for DESTINATION FORM > 

Xbus _ uBooleans, XLDisp, L3 _ checkSource, c3; { destBitMap = current BitMap ? } 

Q uOestHeightA, BRANCH [destNEQCurrent,destEQCurrent, 1], cl; 

destNEQCurrent: 

(destWidth, destHeight have been already checked whether they would be greater than 1024,1010 respectively > 
temp2Low uDestWidthA, CALL [checkWidthAndHeight], c2; 


destEQCurrent: 

GOTO [yesCurrent], 


c2; 


getSTFormMapBase: { for SOURCE FORM } 

temp3Low uCurrentDispBitMap, LI _ getMap, c2; 

CALL (otMap2BankO), C3; 


MAR_templLow_(tempiHigh, templLow + formMapBaselndex), 

LI _getWidth, cl, at [getMap, 10, otMap2Bank0 - return|; 

getMap8ase2: 

templLow _ templLow + 1, 

BRANCH (noPC!nGetMapSase2, yesPCInGetMap8ase2, 1], c2; 


ye$PC!nGetMapBase2; 

templLow __ tempi Low + OFF, c3; 

MAR_[tempi High, tempi Low *■ 0), GOTO [getMapBase2], cl; 


noPCInGetMapBase2: 

otLow _ MD, XDisp, {get SourceForm BitMap Oop} c3; 

getlVlapBase3: 

MAR _ [tempiHigh, templLow + 0], DISP4 [sourceBitMapOop, 0C], cl. {********} 


[]_temp3Low xor otLow, ZeroBr, L3 _ checkSource, GOTO [bitMapOop], 

[j __ temp3Low xor otLow, ZeroBr, L3_checkSource, GOTO [bitMapOop], 

[j _ temp3Low xor otLow, ZeroBr, L3 __ checkSource, GOTO [bitMapOop], 


c2, at (0D, 10, sourceBitMapOop]; {****♦*♦*} 
c2, at [0E, 10, sourceBitMapOop]; {********} 
c2, at [OF, 10,sourceBitMapOop]; {********} 


bitMapOop: 

temp2Low_MD, XHDisp, BRANCH [{CALL} checkSmallfnt2c1, yesCurrentl], c3; 


noCurrentl: 

MAR _ [tempi High, tempi Low + 0], LI _getHeight, cl, at [getwidth, 10, checkSmaiilnt2 - return]; 

temp3Low_temp2Low, CALL [checkSmallInt2], c2; { for checkWidthAndHeight routine) 


noCurrent2: 

Q__temp2Low, LI getMapBase, {Q = Form.Height} c1,at[getHeight,10,checkSmalllnt2-return]; 

temp2Low_temp3Low, CALL [checkWidthAndHeight], c2; {temp2Low = Form.Height} 

{ Atthis point, Q < = = INT(({BitWidth - 1)/16) + 1 )*height, temp2Low = Words/horizontal line. 

Also, otLow = Bitmap Oop(Source, Destination)} 

temp3Low_Q + objectHeaderSize, CALL [otMap2BankOJ, c3, at {checkSource, 10, checkWidthAndHeight-return]; 

(otLow = BitMapOop} 

noCurrent4: 

MAR_templLow_[tempiHigh, templLow sizeFieldOffset], cl, at [getMapBase, 10, otMap2BankO - return); 

getMapBase4: 

BRANCH [noPCGetMapBase4,yesPCGetMapBase4, 1), c2; 


yesPCGetMap8ase4: 

templLow _ tempi Low + OFF + 1, c3; 

MAR _ [tempi High, tempi Low + 0], GOTO [getMapBase4], cl; 


noPCGetMapBase4: 

Q__MD, 


c3; { get BitMap Size } 
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noCurrent5: 

0 _temp3Low xor Q, ZeroBr, {BitMapSize = (width * height) ? } 
temp 1 Low _ tempi Low + 2, { point the actual address of BitMap} 

BRANCH [funnyBitMapSize, correctBitMapSize], 

cl; 

c2; 


correctBitMapSize: 

L2Disp, 

c3; 


RET [getSTFormMapBase - return]. 

cl; 


yesCurrentl: 

CANCELBR ($, OF], 

Noop, 

yesCurrent: 

temp2Low _ 40, L2Disp, 

cl; 

c2; 

c3; { INT {(1024 + 15)/16] = INT [64.9xx] = 64} 


yesCurrent2: 

tempi High __ tempi Low _ (tempi Low xor tempi Low) LRotO, 

RET (getSTFormMapBase - return]. 

cl; { point the Low real memory } 


L2_primFail, GOTO [prlmitiveFailBitBlt31, 

c2, at [0C, 10, sourceBitMapOop]; 


funnyBitMapSize: 

L2_primFail, GOTO (primitiveFaiiBitBltl], 

c3; 


{ 

Subroutine : bbtMultipiy 

C _A*B 

Entry: temp2Low = A 

Q = B 



L2 = return link 

Exit: Q = result 

tempi Low, temp3Low. sourcelndex are smashed 



entry: c'l, c2, c3 exit: cl 
> 



bbtMultiply2: 

Noop, 

bbtMultipiy 3: 

Noop, 

c2; 

c3; 


bbtMultipiy: 

tempi Low_0, 

sourcelndex __ 10, 
bbtMulLoop: 

[1_Q and 1, NZeroBr, 

cl; { product} 

c2; { loop counter for mult - loop } 

c3; 


sourcelndex _ sourcelndex - 1, ZeroBr, 

BRANCH (bbtMulDigitO, bbtMulDigitl], 

cl; 


bbtMulDigitO: 

tempiLow _ DARShiftl (tempiLow + 0), BRANCH (bbtMulLoop, bbtMulEnd], 

c2; 


bbtMulDigitl: 

tempiLow_DARShiftl (tempiLow + temp2Low), 

BRANCH [bbtMulLoop, bbtMulEnd], 

c2; 


bbtMulEnd: 

Q _ - Q, L2Disp, 

c3; 


RET (bbtMultipiy - return]. 

cl; {Result isQ> 


{ Subroutine: getSeveralMasks 

description : calculate the several masks (skew, mask 1, mask2 ) 

sourcelndex : uW - i 

LI : return Link 

Exit: skew: skew 

uMaskl : maskl 

uMask2(temp2Low): mask2 



Note: smashed register - - tempiLow, temp2Low 



Entry: cl. Exit: cl 
> 



getSeveralMasks: 

tempiLow _ uOX, L3_getMask1, 

temp3Low_tempiLow and OF, 

temp3Low_ 10 - temp3Low, 

cl; 

c2; { dx and 15 } 
c3; {16 - (dxand 15)} 
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uStartBits __temp3Low, CALL [makeRightMasks], 
uMaskl _temp2Low, 

sourcelndex __ templLow + sourcelndex, L3 _getMa$k2, 
temp3Low _ sourcelndex and OF, 

temp3Low _0F - temp3Low, CALL [makeRightMasks], 

uMask2_~temp2Low , 

temp3Low __ uSX, L3 _ computeSkewMasks, 
temp3Low_temp3Low - templLow, 


cl; 

cl, at [getMaskl, 10, makeRightMasks - return]; 
c2; { sourcelndex = uW - 1 > 
c3; { (dx +■ W- 1) bitAnd: 15} 

cl; { 15 - ({dx + W - 1) bitAnd: 15)} 

cl, at [getMask2,10, makeRightMasks - return]; 

c2; { to make skewMask} 

c3; 


temp3Low_temp3Low and OF, ZeroBr, L3_computeSkewMasks, cl; 

skew _ temp3Low LRotO, BRANCH IskewNonZero, skewZero], c2; 


skewNonZero: 

temp3Low 10 - temp3Low, c3; 

sourcelndex uBooleans, CALL [makeRightMasks], cl; 


uSkewMask_temp2Low, 

sourcelndex_sourcelndex and 87, GOTO [storeSkewZewoindi], 


cl, at [computeSkewMasks, 10, makeRightMasks - return]; 
c2; 


skewZero: 

sourcelndex_uBooleans, c3; 

uSkewMask _ sourcelndex xor sourcelndex, cl; 

sourcelndex_sourcelndex or 8, c2; 

storeSkewZewoindi: 

uBooleans_sourcelndex, GOTO [getSeveralMasksRet], c3; 


{restoreStatus 

Entry : cl, c2, c3. Exit: c2 
return Link: L2 

} 

restoreStatus: 

ipLow _ uSaveIPL, cl; 

templLow_uSavelPH, c 2; 

ipHigh_templLow LRotO, c3; 

stackLow_uSaveStackL, cl; 

stackHigh _ uSaveStackH, c2; 

homeLow_uSaveHomeL, c3; 

templLow_uSaveHomeH, L2Disp, cl; 

homeHigh_tempi Low LRotO, RET [restoreStatus - return], c2; 


{ 

Subroutine: bbtCheckRange 
Entry: 

destAddrLow : destX 

souuceAddrLow : sourceX 

sourcelndex : destWisth 

temp2Low : cllpx 

temp3Low : dipWidth 

Exit: 


sourceAddrLow : sx or sy 
destAddrLow : dx or dy 
sourccelncex : w or h 
returnLink : L2 
entry: cl, exit: cl 


or destY 
or sourceY 
or destHeight 
or clipY 
or clipHeight 


bbtCheckRange: 

f]_destAddrLow - temp2Low, NegBr, 

Q„temp2Low - destAddrLow, BRANCH [destXGE,destXLT], 


cl; 

c2; {dipX - destX } 


destXLT: {no} 

destAddrLow __ temp2Low, 


c3; { dx _dipX } 


sourceAddrLow __ sourceAddrLow + Q, 
sourcelndex __ sourcelndex - Q, 
destXGE: {yes} 

Q_destAddrLow + sourcelndex. 


cl; {sX_sourceX + (clipX - destX)} 

c2; { w _ width - (clipX - destX)} 

c3: { dx + w } 


checkRIghtRange: 

temp2Low temp2Low + temp3Low, L2Dlsp, cl; { clipX ■+ dipWidth } 

[] temp2Low - Q, NegBr, BRANCH [checkX, checkY, 0E], c2; {(dx + w) > (clipX + dipWidth) ??} 


checkX: 

templLow_uDestWidthA, BRANCH (dipGEOnRightSide, dipLTOnRightSide], c3; 


checkY: 
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tempILow _ uDestHelghtA, BRANCH [dlpGEOnftightSide, dipLTOnRightSide], 

c3; 


dipGEOnRightSide: { clipX+clipWidth > = dx + w} 

Q_ tempi Low - Q,NegBr, 

cl; { dx + w > destWidth ?} 


BRANCH [rangeLEDestForm 1, rangeGTDestForml), 

c2; 


rangeLEDestForm 1: 

GOTO [nextstepl]. 

c3; 


rangeGTDestForml: 

sourcelndex _ sourcelndex + Q, GOTO (nextstepl). 

c3; 


dipLTOnRightSide: { dipX + dipWidth < dx + w} 

0 _ tempILow - temp2Low, NegBr, 

cl; 


temp2Low__Q - temp2Low, {temp2Low = (dx + w) - (ciipx + clipWidth)} 

BRANCH (rangeLEDestForm2, rangeGTDestForm2], 

c2; 


rangeLEDestForm2: 

sourcelndex_sourcelndex - temp2Low, GOTO (nextstepl], 

c3; 


rangeGTDestForm2: 

Q_Q - tempILow, {Q = (dx + w) - Form.Width } 

c3; 


rangeLTDestForm21: 

sourcelndex _ sourcelndex - Q, GOTO (nextStepj, 

cl; 


nextStep 1: 

Noop, 

cl; 


nextStep: 

xbus _ uBooleans, XLDisp, 

c2; { check DestForm = currentScreen?} 


BRANCH [noCurrentlnCheck, yesCurrentlnCheck, 1j, 

c3; { dx < 0 ?? } 


yesCurrentlnCheck: 

{]_destAddrLow, NegBr, 

cl; 


BRANCH (destNoNegative, destYesNegative], 

c2; 


{ if destform = currentScreen, and dx(dy) < 0, we have to make dx(dy) = 0 and ajust the sx(sy), w(h) > 
destYesNegative: 

sourceAddrLow_sourceAddrLow - destAddrLow, 

c3; 


sourcelndex sourcelndex + destAddrLow, 

cl, 


destAddrLow 0, 

c2; 


destNoNegative: 

Noop, 

c3; 


noCurrentlnCheck: 

[]_sourceAddrLow, NegBr, 

cl; 


BRANCH [noSourceNegative, yesSourceNegativeJ, 

c2; 


noSourceNegative: 

L2Disp, 

c3; 


RET [bbtCheckRange - returnj. 

cl; 


yesSourceNegative: 

destAddrLow __ destAddrLow - sourceAddrLow, 

c3; 


sourcelndex sourcelndex + sourceAddrLow, 

cl; 


sourceAddrLow _ sourceAddrLow xor sourceAddrLow, 

GOTO (noSourceNegative!, 

c2; 


{ Subroutine: calSkewWord — 4 click } 

{ 

Entry : cl 

sourcelndex: prevWord 

Q : uHDir 

Exit : c3 

tern p2 Low : skew Word 

Q ; New prevWord for next using 

OtLOW : smashed 

> 

calSkewWord: 

MAR [sourceAddrHigh, sourceAddrLow + 01, 

cl; 


calSkewWord 1: 

sourceAddrLow sourceAddrLow + Q, 

c2; 


Q_MD, 

c3; { get this word } 


uPrevWord __ Q, 

cl; 
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Noop, 

Noop, 

cal$kewWord2: 

sourceindex_sourcelndex and uSkewMask, 

Q_'-uSkewMask and Q, 

calSkew Word3: 

Q _ sourcelndex or Q, Xbus_skew, XDisp, 

bbtFtotation: 

sourcelndex __ LRotl Q, DISP4 [bbtRotL 


L2Disp, temp2Low _ Q, GOTO [bbtShiftO], 

L2Disp, temp2Low _ sourcelndex, GOTO [bbtShiftOI, 

L2Disp, temp2Low_LRotl sourcelndex , GOTO [bbtShiftO], 

L20isp, temp2Low_RRotl Q, GOTO [bbtShift4], 

L2Disp, temp2Low _ Q, GOTO [bbtShift4], 

L2Disp, temp2Low_LRotl Q, GOTO [bbtShift4], 

L2Disp, temp2Low __ LRotl sourcelndex, GOTO [bbtShift4], 
L2Disp, temp2Low _ RRotl Q, GOTO [bbtShift8], 

L20isp, temp2Low _ Q, GOTO [bbtShlftSj, 

L2Disp, temp2Low _ LRotl Q, GOTO [bbtShiftS], 

L2Disp, temp2Low __ LRotl sourceindex, GOTO [bbtShift8], 
L2Disp, temp2Low _ RRotl Q, GOTO (bbtShift 12]. 

L2Disp, temp2Low _ Q, GOTO [bbtShift12], 

L2Disp, temp2Low_LRotl Q, GOTO {bbtShift 12], 

L2Disp, temp2Low __ LRotl sourcelndex, GOTO [bbtShift12], 
L2Disp, temp2Low _ RRotl Q, GOTO [bbtShiftO], 


bbtShiftO: 

RET [calSkewWord - return]. 


bbtShift4: 

temp2Low _ temp2Low LRot4, RET [calSkewWord - return]. 


bbtSh if t8: 

temp2Low_temp2Low LRot8, RET [calSkewWord - return]. 


bbtSh ift 12: 

temp2Low _ temp2Low LRot l2, RET [calSkewWord - return]. 


{Subroutine: getHalftoneWord-2 - clicks} 

{ 

Entry: 

c2, 

sourcelndex : vertical direction 

Exit: 

cl, 

sourcelndex: halftoneWord 


getHalftoneWord: 

temp2Low _ uDY, 
temp3Low _ temp2Low and OF, 

MAR_[halftoneAddrHigh, haiftoneAddrLow + temp3Low], 

temp2Low __temp2Low + sourcelndex, 

BRANCH [noPCInGetHWord, yesPCInGetHWord, 1], 


yesPCInGetHWord: 

haiftoneAddrLow_temp3Low 4- haiftoneAddrLow, 

MAR_[halftoneAddrHigh, haiftoneAddrLow + 0], 

haiftoneAddrLow_haiftoneAddrLow - temp3Low, 

noPCInGetHWord: 

temp2Low _ MD, uDY_temp2Low, LIDisp, 

uHalftoneWord _ temp2Low, RET [getHalftoneWord - return]. 


{ 

Subroutine: checkWidthAndHeight 

Entry: temp2Low = Form.Width 

Q - Form.Height 

L3 = return Link 

Exit: Width * Height > 64640 then primitiveFail, otherwise return 

Note : tempi Low, otLow, Q, sourcelndex is smashed by using bbtMuitipiy routine. 

} 
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c2; 

c3; 


cl; { prevWord _prevWord bitAnd; skewMask } 
c2;{ thisWord bitAnd: skewMaks bitlnvewrt } 

c3; 


cl; 


c2,at[0,10, bbtRotl; 
c2, at ( 1,10, bbtRotj; 
c2, at [ 2,10, bbtRotj; 
c2, at [3, 10, bbtRotj; 

c2, at (4, 10, bbtRotj; 
c2, at [ 5, 10, bbtRotj; 
c2, at ( 6, 10, bbtRotj; 
c2, at [ 7,10, bbtRotj; 

c2, at [ 8,10, bbtRotj; 
c2,at[9, 10, bbtRotj; 
c2, at [0A, 10, bbtRotj; 
c2, at [0B, 10, bbtRotl; 

c2, at [0C, 10, bbtRotj; 
c2, at [0D, 10, bbtRotj; 
c2, at (0E, 10, bbtRot]; 
c2, at [OF, 10, bbtRotj; 


c3; 


c3; 


c3; 


c3; 


c2; 

c3; { dy bitAnd: 15} 
cl; 

c2;{ dy_dy + vDir} 


c3; 

cl; 

c2; 

c3; 

cl; 






checkWidthAndHeight: 

temp2Low__ temp2Low - 1, c3; 

checkWidthAndHeightl: 

temp2Low_temp2Low and ~0F, L2 _ widthAndHeight 

temp2Low_temp2Low LRot12 + 1, 

CALL (bbtMultlplyj, 
smashed} 

{On Smalltalk - 80 on 1 l08X(klku - X), the largest size of BitMap is 64640 word, i.e. 1024*1010/16. If user try to create the form of size 
with greater than 64640, automativally system modify the size with 64640, and not modify the width, height of the corresponding Form. So 
we may have the trouble, since copyBits primitive refers Form.width, height when actually transferring the Bit Block.) 

{Why the reason above, we check it describing below} 

(]_Q, NegBr, c2, at (widthAndHeight, 10, bbtMultiply - return]; 

temp 1 Low _0FC, 

BRANCH (checkWidthAndHeight4, maybeLargerThanMaxSize], c3; 


cl; 

c2; { width_INT((bitWidth - 1 )/16) +■ 1} 

c3; { Q = width * height, tempILow, sourcelndex are 


maybeLargerThanMaxSize: 

tempILow_tempILow LRot8, 

tempILow_tempILow or 80, 

(]_tempILow - Q, NegBr, 


cl; 

c2; {64640 = FC80‘x = 1024*1010/16} 
c3; 


L3Di$p, BRANCH (checkWidthAndHeight41, overBitMapMaxSize], 


cl; 


checkWidthAndHeight4: 

L3Disp, cl; 

checxWidthAndHeight41: 

RET (checkWidthAndHeight - return], <2; 


OverBitMapMaxSize: 

temp2Low _ 0F1, CANCELBR [$, OF], c2; 

L2 _ primFail, GOTO (primitiveFailBitBItl], c3; 


{ Edit history: 

22-Jan-86 16:17:09 
21 -Jan-86 16:46:27 
17-Oec-85 9:00:16 
5-Nov-85 9:12:07 


oop is not current dispfay bitMap 


Tokunaga.iwafx 

Tokunaga.iwafx 

Tokunaga.iwafx 

Tokunaga.iwafx 


4 - Nov - 85 11:31:18 
2-Nov-85 20:09:58 
27 -Sep-85 13:49:07 
13 - Sep- 85 1 1:36:53 
20 - Jun - 85 9:52:54 
10 - Jun - 85 19:38:06 


Tokuanga.iwafx 

Tokunaga.iwafx 

Sakakibara.iwafx 

Tokuanga.iwafx 

Tokunaga.iwafx 

Tokunaga.iwafx 


modify getSTFormMapBase for stretch 

modify the checkWidthAndHeight and getSTFormMapBase 

add the checking routine for dx < 0 or not in bbtCheckRange when DestForm =s CurrentScreen 
add the checking routine for BitMap.Size = (Width*Height) in getSTFormMapBase when bitMap 

add the checking DestForm.width in bbtCheckRange routine, 
add checkSmalllnt2 and checkWidthAndHeight routine 
bug fix CANCELBR 

remove " updateCursor" routine and RegDefs in checkMesalnterrupt routine, 
add checkSmalllnt from bbt.mc 
add bitShift subroutine } 
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{ BBT.dfn 

Definitions for bitblt in Rum, the Dandelion Smalltalk - 80 microcoded virtual machine. 


by T Tokunaga, J Trow 
9 - Feb - 86 17:33:52 


Copyright 1985,1986 by Xerox Corporation. All rights reserved.} 


{ R, RH register } 


RegDef (sourcelndex, 

R, 0]; 

RegDef (skew. 

RH, 0]; 

RegDef [destAddrLow, 

R, 1]; 

RegDef [destAddrHigh, 

RH, ij; 

RegDef (sourceAddrLow, 

R,2]; 

RegDef (sourceAddrHigh, 

RH, 2]; 

RegDef [haiftoneAddrlow, 

R, 4]; 

RegDef [halftoneAddrPligh, 

RH, 43; 


{ U register > 

{ ******** Mesa Stack ********** } 
RegDef [uDestBitMap, 

RegDef (uH, 

RegDef (ul, 

RegDef [uDestAddrLow, 

RegDef [uDestWidthA, 

RegDef [uDestAddrHigh, 

RegDef [uDestHeightA, 

RegDef [uDestDelta, 

RegDef (uMaskl, 

RegDef [uMask2, 

RegDef [uSkewMask, 

RegDef [uCurrentDispBitMap, 

RegDef [uMisc, 

RegDef (uHafftoneAddrlow, 

RegDef [uSourceAddrlow, 

RegDef (uSaveHighAddr, 

RegDef [uNWordsM 1, 

{********** u block 1 ************ } 
RegDef [uSaveIPL, 

RegDef [uSavelPH, 

RegDef [uSaveStackL, 

RegDef [uSaveStackH, 

RegDef [uSaveHomel, 

RegDef [uSaveHomeH, 

RegDef (uArgument, 

^■********** y block 2 ************ y 
RegDef (uSourceDelta, 

{********** U block 3 ************ } 
RegDef [uClipHeight, 

RegDef [uDestMap, 

RegDef [uClipWidth, 

RegDef (uBBTTemp, 

RegDef (uStartBits, 

RegDef (uCilpY, 

RegDef |uW, 

RegDef (uDX, 

RegDef [uBooleans, 

{********** u block 4 ************ } 
RegDef [uCombinationRule, 

RegDef (uDestForm, 

RegDef {uSourceForm, 

RegDef (u$X, 

RegDef (uHalftoneForm, 

RegDef [uDestX, 

RegDef [uDestY, 

RegDef {uSkewWord, 

RegDef (uSourceX, 

RegDef (uPrevWord, 

^********** y block 5 ************ } 
RegDef [uDY, 

RegDef (uVDir, 

RegDef (uHDir, 

RegDef (uSY, 

RegDef [uHalftoneWord, 

{********** u block 6 ************ } 
RegDef [uSourceY, 

RegDef [uMergeMask, 

RegDef [uDestWidth, 

RegDef (uWord, 

RegDef [uDestHeight, 

RegDef [uM Words, 


U, 21; 
U. 3}; 
U, 3}; 
U, 4j; 
U, 4J; 

U. 53; 
U, 5]; 
U, 6]; 
U, 73; 
U, 83; 
U, 93; 
U. 9]; 
U, 0A]; 
U, OB]; 
U, GC1; 
U.0D3; 
U, OEj; 


U, 14J; { save Smalltalk instruction pointer } 

U, 17]; 

U, 19J; { save Smalltalk stack pointer } 

U, 1AJ; 

U, i Bj; { save Smalltalk home context pointer} 
U, 1 Dj; 

U, IE]; { combinatin Rule } 


U, 24|; 


U, 31] 
U, 31] 
U, 34] 
U, 34] 
U, 35] 
U, 35] 
U, 37] 
U, 38] 
U, 3C] 


U, 42] 
U.43] 
U, 44] 
U,47l 
U, 4B] 
U.4C] 
U, 4D} 
U, 4E] 
U, 4F] 
U.4F1 


U, 55], 
U, 581, 
U, 5C] 
U,5D] 
U, 5DJ 


U, 63] 
U, 63] 
U,6A 
U,6A] 
U, 6B] 
U,6B] 
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RegDef [uClipX, 
RegDef [uHMI, 


U,6D]; 

U,6F]; 


*********************** 


************* 


{***** 

********** constant 

********************************************** 


Set (CSBforCursorHigh, 2]; 

Set (CSBforCursorLow, QFO]; 


Set [destForm Index, firstFieldOf Object]; 

Set [diffDFAndHF, 2]; 


Set (diffCurrentBitMapAndCursor, Sub [cursorBitmapOopOffset, displayBitmapOopOffset]]; 
Set [halftoneFormlndex, Add [firstFieldOfObject, 2]]; 

Set [difFieidAndSize, Sub [firstFieldOfObject, sizeFieldOffset]]; 

Set [firstFieldOfObjectMl, Sub [firstFieldOfObject, 1]]; 


{ getSTFormMapBase : L2 } 

Set (getDestSitsAfterMInt, 01; 

Set (getDestBits, ij; 

Set [getSourceBits, 2]; 

Set [formMapBaseindex, firstFieldOfObject]; 

Set [formMapBitsNolndex, Add [1, firstFieldOfObject}]; 

Set [formBitslndex, firstFieldOfObject]; 

Set [formWidth!ndex. Add [1, formBitslndex]]; 

Set fformHeightlndex, Add [1, formWidthlndex]];; 


{ checkSmalllnt: Li} 

Set [checkCombinationRuie, 0]; 

Set [checkDestX, 1]; 

Set (checkDestY, 2]; 

Set [checkDestWidth, 3]; 

Set (check DestHeight, 4]; 

Set [checkSourceX, 5]; 

Set [checkSourceY, 6]; 

Set [checkCIipX, 7]; 

Set [checkClipY, 8]; 

Set [checkClipWidth, 9]; 

Set (checkClipHeight, 0A 

Set [checkSourceFormHeight, OB] 

Set [checkSourceFormWidth, 0C] 

Set [cursorWidth, 0D 

Set [getWidth, 0E] 

Set [cursorWidth 1, OF} 

{ checkSmalllnt2: LI} 

Set [checkDestForm width, 0]; 

Set [checkDestFormHeight, 1 j; 

Set (getWidth, 2]; 

Set [getHeight, 3|; 


{checkWidthAndHeight: L3 } 

Set [checkClip, 0]; 

Set [checkDest, 1]; 

Set [checkSource, 21; 


{male eRig ht M asks} 

Set [getMask 1 Again, 0]; 

Set (getMask2Again, ij; 

Set (getMask 1, 2]; 

Set (getMask2, 3]; 

Set [computeSkewMasks, 4]; 


{bbtMultipiy: L3} 

Set [getSourceMul, 0]; 

Set [getDestMul, ij; 

Set [widthAndHeight, 2]; 


{getSeveraiMasks-get skew, mask 1, mask2} 


Set [getMasks, 0]; 

Set [getMasksAgain, ij; 


{checkFormNil} 

Set [checkSourceFormAgain, 0]; 

Set (checkHalftoneFormAgain, ij; 


{bitBBTShift} 

Set [bitShiftSkewP, 0]; 

Set [bitShiftSkewM, ij; 
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A 




{checkiVHnt} 


Set [bbtCheckMtnt, 

01; 

{updateCursor} 


Set (cursorAndDest, 

0]; 

Set (cursorAndSource, 

i]; 

{restoreStatus} 


Set (bitbltFlnished, 

01; 

Set [bitbltlMotFinished, 

U; 

Set [primFail, 

7]; {must be odd} 

Set [noTransfer, 

31; 

{checkRange: 12 } 


Set [checkX Range, 

0]; {must be even} 

Set [checkYRange, 

ij; {must be odd} 

{calSkewWord: L3 > 


Set [skewWord, 

01; 

Set [skewWordl, 

il; 

Set (combOD, 

21; 

{write: L2 } 


Set [combODOl, 

01; 

Set (comb0D02, 

il; 

Set (comb0D03, 

21; 

Set (combOD 04, 

31; 

Set (comb0D06, 

41; 

Set [comb0D07, 

51; 

Set fcombODOS, 

61; 

Set [comb0D09, 

71; 

Set (combODOB, 

81; 

Set [combODOC, 

91; 

Set (combODOD. 

0A]; 

Set [combODOE, 

0B!; 

{mergeSrcAndDest: L2 } 


Set (hPISFormNli, 

il; 

Set [hPINoLast, 

01; 

Set [hPINoLastSFNonNil, 

21; 

Set (hM ISFormNil, 

51; 

Set [hM 1 NoLast, 

41; 

Set [hMISFormNonNil, 

91; 

Set (hM 1 NoLastSFNonMil, 

81; 

Set [hP ISFormNonNil, 

0D]; 

{ Edit history: 


22-Jan-86 15:41:19 Tokunaga.fx 

add constant for checksmalllntl, checkWidthAndHeight } 
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Title(AltoBltBlt.rnc...July 3, 1981 4:54 PM...P. Deutschl; 

* 26 September 1984 1:15:50 pm PDT (Wednesday) gk mode 5/10. fix 
‘Modified from version April 17, 1981 7:32 PM Taft, 

* to include Smalltalk mode and remove pre - touching of pages 

* Bit - boundary block - transfer 

* This version emulates Alto and Smalltalk BitBlt, 

* including the use of long pointers. (9 December 1982 1:27:04 pm ) 


% 

Refer to the Alto Hardware Manual for primary documentation. 
All numbers are octal except timings, which are decimal. 


BBTable format: 
0 
1 
2 

3 

4 

5 

6 
7 
10 
11 
12 

13 

14 

15 

16 
17 
20 
21 
22 

23 

24 

25 


Function (see below) 
unused 

DBCA 

destination base core address 

DBMR 

destination bit map raster 

DLX 

destination left X 

DTY 

destination top Y 

DW 

destination width (also source width) 

DH 

destination height (also source height) 

SBCA 

source base core address 

SBMR 

source bit map raster 

SIX 

source left X 

STY 

source top Y 

GrayO 

Grayl 

Gray2 

Gray3 

(for Alto BitBlt; ignored for Smalltalk BitBlt) 

LSBCAIo 

LSBCAhi 

long pointer to source bit map 

LDBCAIO 

IDBCAhi 

long pointer to destination bit map 

LGBCAiO 

LGBCAhi 

long pointer to gray bit map (Smalltalk only) 


Function: 

B0 = 1 Use the long pointers in words 20 - 23 and ignore DBCA, SBCA 
81=1 Use Smalltalk operation codes, and gray pointer in words 24 - 25 

Following 2 bits def ined only if NOT using long pointers: 

B10 s 1 Source block is in the alternate bank (XM) 

811 = 1 Destination block is in the alternate bank (XM) 

Following bits are defined only in Alto mode: 

812:13 SourceType 
B14:15 Operation 

Following bits are defined only in Smalltalk mode: 

B8:9 SourceType: 

88 Source is supplied (otherwise ail ones) 

89 Gray is supplied (otherwise all ones) 

B12:15 Rule for combining dest __ f(dest, source AND gray): 

812 dest_1 if (NOT dest) AND NOT (source AND gray) 

B13 dest _ 1 if dest AND NOT (source AND gray) 

B14 dest_1 if (NOT dest) AND (source AND gray) 

315 dest_1 if dest AND (source AND gray) 


The 20 BitBlt Functions (combinations of SourceType and Operation) are 
divided into 6 classes: 

A dest_gray 

B dest _ f(gray, dest) 

C dest _ f(source) 

D dest __ f (source, gray) 

E dest_f(source, dest) 

F dest_f (source, gray, dest) 

The distribution of functions into classes for Alto mode is: 


Function (class) 

SourceType 

Operation 

0(0 

0 source 

0 dest _ source 

1 (E) 

0 source 

1 dest _ source OR dest 

2(E) 

0 source 

2 dest __ source XOR dest 

3(E) 

0 source 

3 dest _ NOT source AND dest 

4(0 

1 NOT source 

0 destsource 

5(E) 

i NOT source 

1 dest_source OR dest 

6(E) 

1 NOT source 

2 dest _ source XOR dest 

7(E) 

1 NOT source 

3 dest _ NOT source AND dest 

10(D) 

2 source AND gray 

0 dest _ source 

11(F) 

2 source AND gray 

1 dest _ source OR dest 

12(F) 

2 source AND gray 

2 dest _ source XOR dest 

13(F) 

2 source AND gray 

3 dest __ NOT source AND dest 

14(A) 

3 gray 

0 dest _ source 

15(B) 

3 gray 

1 dest _ source OR dest 

16(B) 

3 gray 

2 dest _ source XOR dest 

17(B) 

3 gray 

3 dest_NOT source AND dest 


in Smalltalk mode, rules 0 (all zeroes), 17 (all ones), 3/14 (dest/not dest), 
and 5/12 {source/not source) require special treatment; ail other rules imply 
a function that uses both the dest and source operands. 

The degenerate case of neither source nor gray is handled by 
constructing a fake 1 - word gray block containing all ones. 

Thus the distribution of functions into classes for Smalltalk mode is: 

Rule (class) SourceType 

0, 17(A) 0 all ones 

others (B) 0 all ones 
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0,17(A) 

1 gray 

3, 14(B) 

1 gray 

5, 12(A) 

1 gray 

others(B) 

1 gray 

0,17(A) 

2 source 

3, 14(B) 

2 source 

5,12(C) 

2 source 

others (E) 

2 source 

0,17(A) 

3 source AND gray 

3, 14(B) 

3 source AND gray 

5, 12(D) 

3 source AND gray 

others (F) 

3 source and gray 


2 
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If DLX < a SLX, the BltBlt horizontal loop works left -to -right; if DLX > SIX, 
right-to-left. Similarly, if DTY < STY, the vertical loop works top - to - 
bottom: if DTY >= STY, bottom-to-top. This is so that the correct thing 
will happen if source and destination blocks overlap. (Note that this test 
depends on the assumption that if the blocks overlap, they belong to the 
same bit map, i.e., DBCA = SBCA and DBMR = SBMR. No check is made for this.) 
The " = “ cases could be handled either way; however, the DTY = STY 
case must be handled bottom - to - top because the documented algorithm for 
proper phasing of the gray block depends on this. 

Terminology: when referring to words in a scan line, "left 1 ' and "right" 
refer to the words with lower and higher addresses, respectively, independent 
of the direction of processing the scan line; "first" and "last" refer 
to the first and last words encountered in the direction of processing. 

The destination block is considered to consist of a left partial word, 
some number of full (body) words, and a right partial word. If the block 
begins or ends on a word boundary, the left or right word is still 
considered to be a partial word. 

The destination bits preserved in the left and right partial words 
are determined by the 5HC register's LMask and RMask, respectively, 
where (.Mask = DLX mod 20, RMask = 17-((DLX + DW-1) mod 20). 

The destination width in words, including the first and last partial words, 
is computed by DWidth = (DW + (DLX mod 20) + 17)/20. Similarly, 
the source width in words, including the first and last partial words, 
is computed by SWidth * (DW + (SLX mod 20) + 17)/20. 

DWidth and SWidth differ by at most + /- 1. 

if DWidth > 2 then the destination consists of a left partial word, DWidth - 2 
full body words, and a right partial word. 

If DWid th = 2 then the block consists of a left partial word immediately 
followed by a right partial word. 

if DWid th = 1 then the entire destination block lies within a single word, 
not crossing a word boundary. Effectively, the left and right partial words 
are one and the same. This case (called the "thin" case) requires 
special handling, as both LMask and RMask must be applied simultaneously. 

Processing of the scan line is controlled by two counters: the Cnt register 
(loaded from (Cnt), which counts the inner loop (20 words or fewer), and 
MCount, which counts the outer loop. Roughly speaking, 

Cnt is loaded initially with DWidth mod 20 and MCount with DWidth/20. 

The inner loop is executed Cnt times; then, until MCount is exhausted, 

Cnt is reloaded with 2Q and the inner loop is executed 20 more times. 

The reason for this arrangement is to permit a Prefetch to be executed 
every 20 words. 

More precisely: Before each horizontal loop, the Cnt register is loaded with 
if DWidth < 23 then DWidth - 1 else (DWidth - 3) mod 20 + 2, so: 

Cnt > 1 if the body contains one or more words. 

Cnt = 1 if there are no body words. 

Cnt = 0 in the thin case. 

Cnt is decremented twice before the main loop is reached, so upon entry 
to the main loop it contains DWidth -3 (assuming DWidth <23), which is precisely 
the correct value for going around the loop DWidth - 2 times. (The extra 2 
in DWidth are the first and last partial words, which are handled outside 
the word loop.) 
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MCount is loaded with (DWidth - 3)/20 - 1. so: 

MCount < 0 if DWidth < 23 
MCount = 0 if 23 < a DWidth < 42, etc. 

Each time the inner loop terminates, if MCountcO the scan line is finished, 
but if MCount > = 0, MCount is decremented, Cnt is loaded with 17, and the 
main loop is reentered for another 20 iterations. 

When working left - to - right, the source may be thought of as T„SrcWd — 
that is, with T on the left and SrcWd on the right. In any given operation, 

T contains the previous source word and SrcWd contains the current one, and 
the shift operation consists of left - shifting T„SrcWd by 0 to 17 bits 
(to align it with the destination) and storing the leftmost 20 bits of the 
result. Since the shifter is actually a cycler and produces the rightmost 
20 bits (rather than the leftmost) of the cycled result, the shifter must 
be set up to left - cycle an additional 20 bits (by exchanging SHA and SHB). 

HenceSHA -Rand SHB=T. 

When working right - to - left, the source may be thought of as SrcWd„T, 
where T contains the previous source word and SrcWd the current, as before. 

This is exactly symmetric with the left - to - right case and requires only 
that SHA and SHB be exchanged. Hence SHA - T and SHB = R. 

Regardless of the direction, if there are at least as many data bits in the 
first word of the source block as in the first word of the destination block, 
then all the destination bits come from SrcWd during the first shift and 
T need not be loaded at all. On the other hand, if there are fewer bits 
in the first word of the source block, the destination bits come from 
both SrcWd and T. In this case, T must contain the first source word and 
SrcWd the second. These two situations must be distinguished, since one 
requires fetching only a single word whereas the other requires fetching 
two words before operating the shifter for the first time. 

A similar situation arises at the end of a block; that is, all the bits 
>n the last partial destination block may come from the leftover source 
word in T, or it may be necessary to fetch an additional word into SrcWd. 

These situations must be distinguished also. An earlier version of this 
microcode omitted the test and simply fetched the "extra" word always; 
unfortunately, this sometimes resulted in touching a word outside the bit map, 
which caused problems in a paged environment when the bit map happened 
to be page-aligned. 

Two bits in 8BFIags control the fetching of the "extra" word in the above 
two cases. 

All the horizontal loops work in both directions by use of a trick: 

ALUt : {15] is redefined to be A + 1 if moving left - to - right but A - 1 if 
right- to - left. This ALU function is invoked by the operation "A + /- 1", 
and ts used to advance source and destination pointers along the scan line. 

A consequence of this is that ALUF(15] (normally A AND NOT B) cannot be 
used by I/O tasks. 

8BDst and BBSrc are 16 - bit displacements relative to base registers 
BBDstBR and BBSrcBR. If moving top - to - bottom they start near zero 
and count up; if bottom-to-top they start at ~2‘15 and countdown, 
if more than ~2'15 words of bit map are processed, one of these displacements 
becomes negative. This is detected and causes BitBIt to restart, recomputing 
the base registers and displacements. BR displacement overflow is handled 
this way because it takes too much code to recompute the BRs and displacements 
in mid - stream. The cost of restarting BitBIt from scratch in this case is 
unimportant, since such a large amount of data is involved. (Indeed, in 
norma! programs an interrupt will occur before 2 ' 15 words are processed, 
so BitBIt will be restarted anyway.) 
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* BitBlt Calling Sequence 


The QitBIt subroutine is called by: 

SCalllBItBItSub] 

with the Top - of - Stack (TOS) containing the following arguments; 

TOS -1; pointer to BBT able (in current space) 

TOS; 0 

Assumes RBase[AEmRegs] when called and leaves it that way upon return. 

Assumes that the BBT able is relative to the MemBase in effect at the time 
of the call. The caller shouldn't assume anything about MemBase upon return. 

BitBlt exits in one of two ways: 

1. Normal completion: BitBlt sets TOS to zero and returns to caller + 2. 

2. interrupt request pending; BitBlt sets TOS to the number of scan lines 
already processed and returns to caller +• 1. The calling emulator processes 
the interrupt and then restarts the BitBlt with the value left in TOS. 

Note: if the BitBlt source or destination block is larger than 2*15 words, 

BitBlt stops after processing at most 2" 15 words and returns + 1, exactly 
as if an interrupt had occurred. 

Local stack usage: 


TOS - 1: 

BBTable 

TOS: 

number of scan lines completed 

TOS + 1: 

not used (preserved for Alto Emulator's benefit) 

TOS+ 2: 

return Link 

TOS+ 3: 

saved ALUFM(17| 

TOS+4: 

saved ALUFM{15] 


Approximate timing for initialization and cleanup (excluding main loops): 
69 cycles (minimum) 

+• 4 if working bottom - to - top 
+ 21 if DTY # 0 or working bottom - to - top 
+ I if DWidth = 1 or DWidth > 22B 
Add the following if a source bit map is required: 

+ 31 

a- 5 if working right - to - (eft 
+■ 4 if working bottom - to - top 
+ 21 if STY # 0 or working bottom - to - top 
+ 5 if DWidth = SWidth 
+ 1 if SWidth = 1 

+ 2 if STY = DTY and SBMR = DBMR 

95 cycles maximum in destination - only cases 
164 cycles maximum in source - destination cases 

See comments above main loops for main loop times. 

These timings are for Alto mode; Smalltalk mode is a little slower 
for the initial setup. 

% 
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* R - register assignments: 


SetRMRegionfBBRegsj; * The RMRegion itself is defined in RegisterOefs.mc 

RVN(BBDst]; * Address of next word to process 

RVN[BBSrc]; 

RVNfDstlnc]; * Address increment between scan lines — 

RVN(Srclnc]; * negative if working bottom - to - top 

RVN(DRast]; * Raster length (words) — 

RVN(SRast); * negative if working bottom - to - top 

RVN(PrefDst]; * Address of next munch to Prefetch 

RVN(PrefSrc); 

RVN(DPrefOffseti; * Offset of leftmost word of next scan line relative 

RVNfSPref Offset]; * to first word of current scan line 


RVNfVCount]; 

RVNfMCountj; 

RVN(ICnt]; 

RVNI’BBDispI; 


RVNfBBFlags!; 


RVNfSrcWdj; 


* Vertical line count 

* Horizontal munch count 

* Initial value of Cnt register for word loops 

* Control flags and horizontal loop dispatch 

* 80 - 1 - > work right - to - left 

" B8:15 = dispatch value relative to HorizontaiDisp 

* (see below for details) 

* Control flags: 

* 90 = 1 = > 2 source words required for first dest word 

* B15- 1 =* > 2 source words required for last dest word 

* Leftover source word — must be RVREL 17 


* Additional registers, overlaid with emulator temps in the AEmRegs block. 

RME[BBRule, ETempO]; * Low 4 bits of function word (during initialization only) 

RMEJGrayDirection, ETempO]; * 0 if working top-to-bottom, -1 If bottom - to - top 

RME(GrayAddrMask, ETemplj; * Mask for low bits of gray offset: 

* 3 If Alto mode, 17 if Smalltalk mode and SourceType 

* not zero, 0 if Smalltalk mode and Sourcefype = 0 

RMEfGBCAlo, ETemp2J; * long pointer to gray block 

RME[GBCAhi, ETemp3]; 

RME[GrayOffset, ETemp4|; * Offset within gray of first scan line 


' Aliases used during initialization 


RME[width, OPref Offset]; 
RME[DWidth, (Cnt]; 
RM£[SWidth, PrefSrc]; 
RME[Skew, Dstlncj; 
RME[BBMasks, PrefDst]; 
RME(BBFunc, Srclnc]; 
RME[DstX, BBDstj; 
RME[SrcX, BBSrcj; 
RME[DstY, SPrefOffsetj; 
RME[SrcY, SRast]; 
RME[BBTemp, SrcWdl; 


' Width of block in bits 

* Width of destination block in words 

* Width of source block in words 

* Destination - source skew, mod 20 

* LMask and RMask values to be loaded into SHC 

* BitBIt function word 

* Destination starting X in bits, later in words 

* Source starting X in bits, later in words 

* Destination starting Y in scan lines 

* Source starting Y in scan lines 

* Must be RVRel 17 because it is an arg to MulSub. 
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* Other definitions 


* Base- register assignments 

% — Actually defined in ADefs. me. First two must be an even-odd pair. 
BR[BBD*tBR, ?]; * BitBlt destination base 

BR[BBSrcBR, ?]; * BitBlt source base 

BRfScratchBR, ?]; * Scratch (emulator use only) 

% 


* ALU functions defined by BitBlt. 

* The ALUF Ram is loaded by BitBlt with the desired operations. 

XALUOPf,8BOp„17,El; * A BBOp B — logical operation invoked with shifter 

XAOP{, W- 1,15/E]; * A +/- 1 —A h 1 or A-1 depending on horizontal 

* direction. This value of ALUF is normally 

* A AND NOT 8 and is restored by BitBlt when done. 

* This means, however, that A AND NOT B cannot be used 

* by other tasks. 


* Layout of BBDisp register: 

* BO = 0 if working (eft - to - right, 1 if right - to - left 
*88-15: BlgBDispatch value for setup and body dispatches. 

* The following addressing constraints apply: 

* (1) B9 = 1 and Bi5 = 1 If a source bit map is used. 

* (2) B12 =* 1 and B13 = 0 if gray is used; B12 = 0 and B13 - 1 otherwise. 

* (3) BI 1 = 1 if the destination is an operand. 

* (4) Certain targets are tied together by Call constraints. 

* These bits are rather carefully selected to permit the same BBDisp to be 

* used in three different dispatches. 

Set($rcFlg, 1011; 

Set{NoGrayFlg, 4]; 

SetfGrayFIg, 101; 

Set(DstFlg, 201; 

* BBDispX defines the first of two pages used for dispatches on BBDisp. 

* BBOispX must refer to an even page. 

Set(B8DispX, 1200]; 

Al(BBDispX, Add[#1, #2|]3; 

* Page -- relative entry points for setup routines. 

* All must have Bi 1 = 1, to neutralize body dispatch (DstFlag). 

Set{GrayDstSetupLoc, 30]; 

Set{SrcDstSetupLoc, 1251; 

Set(SrcGrayDstSetupLoc, 131]; 

Set(Horizonta)DispLoc, 201; * Target of setup dispatch 

* Page - relative entry points for body routines. 

* They must neutralize all bits used for the setup dispatch. 

Set(GrayBodyLoc, 161; 

Set[GrayDstBodyLoc, 36]; 

Set{SrcGrayBodyLoc, 1171; * These must be xxxxl 111 because they contain 

SetfSrcGrayDstBodyLoc, 1371; * conditional Call instructions 
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BitBItSub: * Entry point 

* Preliminaries: read BBTable, decode function 


KnowRBasefAEmRegs]; 

Subroutine; 

T_Link, StkP- 1; 

Topi.evel; 


Fetch_ Stack& +3; * Fetch Function from BBTable 

Stacks + 1_T, MemBase_ ScratchBR; 

* Set up ScratchBR to point to base of BBTable. 

T_VAHi; 

BRHi_T; 

T_VALO; 

BRLo_T; 

BBRuie_(17S) AND MD, T_MD; * BBRule_function dispatch 

BBFunc_MD; * Save function word 

* (only to test XM flags below) 

* Dispatch on BitBlt function to compute BBOP and BBDisp. 

* The dispatch is quite different in the Aito and Smalltalk cases. 

* Note that MD still contains the full BitBlt function word. 

PD _ T and (40000c); 

DblBranchfSTBBDisp, AltoBBDisp, ALU # 0]; 


* Smalltalk mode dispatch 
STBBDisp: 

GrayAddrMask _ 17C; *16-word gray 

T _ LDF[T, 2,6]; * Source type 

GBCAiO_24C; 

GBCAlo_(Fetch_GBCAlo) + 1; * Fetch long gray pointer 

GBCAIo _ MD, Fetch _ GBCAlo; 

BBRule _ T, Big8Dispatch_ BBRule; * BBRule _ source type 

GBCAhi_MD, Branch[STBBFunctionTable]; 


STBBFunctionTable: DispTable[20]; * Rule 

* Note that the rule specifies dest _ g(dest, maskedSource), 

* but the loops all do dest _ f(NOT maskedSource, dest). 


T _ A0, BranchlSTBBFZ], 

T_21C, Branch[STBBFJ; 

T_ 11C, Branch(STBBF]; 

T_ 1C, Branch[STBBFSj; 

T_35C, BranchfSTBBFl; 

T _ 25C, Branch[STBBFDl; 

T_ 15C, Branch[STBBF]; 

T_ 5C, Branch[STBBF]; 

T__33C, Branch(STBBFl; 

T_23C, BranchfSTSBF]; 

T__ 13C, Branch[STBBFD]; 

T_ 3C, BranchfSTBBF]; 

T_37C, Branch[STBBFS]; 

T_27C, BranchfSTBBF]; 

T_17C, Branch[STBBF}; 

T_T - T - 1, Branch[STBBFZj; 


0 all zeros 

* 1 A AND B 

* 2 NOT A AND B 

* 3 B 

* 4 A AND NOT B 

* 5 A 

* 6 AXORB 

* 7 A OR B 

* 10 NOT A AND NOT B 

* 11 A EQVB 

* 12 NOT A 

* 13 NOT A ORB 

* 14 NOT B 

* 15 A OR NOT B 

* 16 NOT A OR NOT B 
17 all ones 


* Re - dispatch on the source type 

* Rule uses neither source nor dest 
KnowRBase[AEmReg$j; 

STBBFZ: 

Store _ 17S, Dbuf _T, Cal![$etFakeGray]; * Construct one - word gray 

T_1C; * ALU function to select maskedSource 

RBase __ RBase[BBRegs], Branch[SBBFA]; *do this way for placement 

* Rule uses dest but not source 
KnowRBasefAEmRegs]; 

STBBFD: 

Call[SetFakeGray]; * 9/26/84 Construct one - word gray 

RBase _ RBase[BBRegs], Branch[SBBFB]; *do this way for placement 

* Rule uses source but not dest 
KnowRBa$e[AEmRegs]; 

STBBFS: 

BDispatch_BBRule; 

RBase _ RBase[BBRegs], Branchf. + 1|; 

DispTable[4], 

RBase __ RBase(AEmRegs), BranchlUseAllOnes]; 

PD_T - i, Branch[TestCompSource|; 

BranchfBBFC]; 

8ranch[BBFD]; 

TestCompSource: * Test if using gray or gray' 

DblBranch[SBBFA, SBBFB, ALU = 0]; * Only use case A if gray straight through 

SBBFA: Branch[BBFA]; ^placement 

SBBFB: Branch[BBFBj; *placement 

* Rule uses both source and dest 
KnowRBasefAEmRegs]; 

STBBF: 

BDispatch __ BBRule; 

RBase_RBase[BBReg$|, Branch!. + 1J; 

DispTable(4], 

RBase_RBase(AEmRegs], BranchlUseAllOnes]; 

BranchfBBFB]; 
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Branch(BBFE); 

Branch[BBFF]; 


UseAllOnes: 

GrayAddrMask _T - T - 1; 

Store __ 17S, Dbuf _ GrayAddrMask, Call[SetFakeGray]; 
RBase _ RBase[BBRegs], Branch[SBBFB]; 

* Subroutine to set address of fake gray 
Subroutine; 

KnowRBasefAEmRegs]; 

SetFakeGray: 

GBCAhl_VAHi; * Set gray pointer 

GBCAIo_VALo; 

GrayAddrMask_AO, Return; * 1 - word gray 

Top level; 

********** 


* Alto mode dispatch 
KnowR8ase(AEmRegs]; 

AltoBBDIsp: 

GrayAddrMask __3C; *4-word gray 

T_14C; 

Dummy Ref_T; * Compute pointer to gray 

GBCAhi_VAHi; 

GBCAIo __ VALo; 

BigBDispatch_ BBRule; 

Rbase _ Rbase[BBRegs], Branch[AltoBBFunctionTablel; 


AltoBBFunctionTable; DispTable[20]; * SourceType, Operation 


T 1C, Branch[BBFC|; 

*0,0 

NOT A 

T__5C. Branch[BBFE]; 

*0,1 

NOT A OR B 

T_15C, Branch[BBFE!; 

*0,2 

A EQV B 

T_35C, Branch[BBFE]; 

*0,3 

A AND 8 

T 37C, Branch(BBFC); 

* 1,0 

A 

T_27C, Branch[BBFE]; 

* 1, 1 

A ORB 

T_23C, Branch[BBFEj; 

* 1,2 

AXORB 

T_21C, Branch[BBFEj; 

* 1,3 

NOT A AND B 

T_1C. BranchfBBFD]; 

* 2,0 

NOT A ' 

T 5C, BranchfBBFFj; 

* 2, 1 

NOT A OR B 

T 15C, Branch[BBFF]; 

*2,2 

A EQV B 

T_35C, Branch[BBFF|; 

*2,3 

A AND B 

T_1C, Branch[BBFA|; 

*3,0 

NOT A 

T_5C, BranchfBBFBj; 

*3, 1 

NOT A OR B 

T 15C, BranchfBBFB]; 

*3,2 

A EQV B 

T 35C, Branch[BBFB}; 

*3,3 

A AND B 


* Select the appropriate dispatch word for the function. 

BBFA: BBDIsp Add{GrayFlg]C, Branch[SetBBF]; 

BBFEt: BBDisp Add{GrayFlg, DstFlgjC, Branch[SetBBFj; 

BBFC: BBDisp_Add[SrcFlg, NoGrayFlgjC, Branch[SetBBF]; 

B8FD: BBDisp_Add{SrcFlg, GrayFlg]C, Branch[SetBBF]; 

BBFE;: BBDisp_Add{$rcFlg, NoGrayFlg, DstFlgjC, BranchfSetBBF]; 

BBFF; BBDisp_AddJSrcFIg, GrayFIg, DstFlgjC, Branch[SetBBF]; 

SetBBF: Stack& + 1_ALUFMRW_T, ALUF[17]; * Set ALU function and save old 
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* X -- coordinate setup: widths, margins, skew, masks, etc. 


* Fetch the X - coordinate information. 

MCount__ NOT (Fetch__ 6S); * MCount_small negative, fetch DW 

Width_MD, Fetch_12S; * Fetch SIX 

SrcX_ MD, T_AO, Fetch_4S; * Fetch DLX — must be fetched last 

* Compute LMask and RMask. 

* LMask = DLX mod 20, RMask = 17 - ((DLX + DW - 1) mod 20) * (-DLX - DW) mod 20. 

* For reference, SHC fields are: 

* B2: SHA = T, B3: SHB =T, B4 - 7: count, B8 - 11: RMask, B12 - 15: LMask 

DstX_M D, T_ T - (Width); * T_ - DW 

T_T- (DstX); * T_ - DLX - DW 

BBMasks_DPF(T, 4, 4, MD]; * B8 - 11_ {( - DLX - DW) mod 20) Ish 4, 

* B12 - 15_DLX mod 20 

* Compute destination width in words, including first and last partial words. 

* DWidth_ (Width + (DLX mod 20) + 17)/20. 

T_ (DstX) AND (17C); 

T_(Width) + T; 

T_T + (17C); 

□Width_RSH[T, 4]; 

BBDisp, Branchf. + 2, R odd]; * Source block required? 

* Source block not required. Set shift count to send R straight thru shifter, 

* and handle as left - to - right case. 

Skew_ A0, Branch[$etupLtoR]; * SHA = R, SHB a R 

* Compute source width in words, including first and last partial words. 

* SWidth_(Width + (SLX mod 20) + 17) i 20. 

T _ (SrcX) AND (17C); 

T_(Width) + T; 

T_T + (17C); 

SWidth_T_RSH[T, 4|; 

* Set flags to control fetching of "extra" first and last words. 

* Except in the "thin" case (DWidth = 1), the setup/finish routines for the 

' horizontal loops nominally fetch 1 word and store 2 words; an extra fetch 

* may be required at the beginning, the end, or both, depending on the number 

* of words in the source and destination blocks (see introductory comments). 

* DWidth and SWidth differ by at most +/ - 1. 

* If SWidth = DWidth + 1, an extra source word must be fetched at both ends. 

* If SWidth » DWidth - 1 or SWidth = 1, no extra source words need be fetched. 

* If SWidth = DWidth # 1, an extra source word must be fetched at one end: 

* if SLX mod 20 > DLX mod 20 then left else right. 

* Set BBFIagstO]_extraLeft, BBFIags{l:15]_extraRight. 

* (these flags are exchanged later if working right - to - left.) 

* T still has SWidth; MD still has DLX. 

* The following 2 instructions set BBFIags_ - 1 if SWidth > DWidth, 0 otherwise 

PD__ (DWidth)-T; 

BBFiags_T - T- 1, XorSavedCarry, Branch[SetupSkew, ALU#0|; 

* Set BBFiags_ 100000 if SLX mod 20 > DLX mod 20, 77777 otherwise. 

T_(SrcX) AND (17C); 

BBF1ags__(17$) AND MD; * DLX mod 20 

PD T - (BBFiags) - 1; * Carry iff SLX mod 20 > DLX mod 20 

BBFiags_ 100000C; 

BBFiags_(BBFiags) - 1, XorSavedCarry; 


bitbit 1. me 


26 - Sep - 84 13:16:22 PDT 


10 





X - coordinate setup (cont'd) 


* Compute skew = (SLX - DIX) mod 20, and decide on horizontal direction. 
SetupSkew: 

T_(SrcX) - MD; 

Skew__ T AND (17C), DblBranch(SetupRtoL, SetupLtoR, ALU <0]; 


* SLX > = DLX: work from left to right. SetSHA = R,SHB = T,ALUF[l5l = "A+ 1". 

* Mote: if skew = 0, set SHA = R, SHB =a R. 

SetupLtoR: 

T_ 200C, Branch{NoSrcThinChk, ALU = 0|; * ALUFM control for "A+ 1" 
Skew_(Skew) Oft(20C), Branch(5etupALU&$hC); * SHB =T 


* SLX < DLX: work from right to left. 

* Set SHA = T, SHB = R. ALUF[15] = "A - 1". 

* Advance starting X coordinates to rightmost ends of blocks. 

* Note: if skew = 0, set SHA = R, SHB = R, and do not exchange extra - word flags. 
SetupRtoL: 

BBDisp_(BBDisp) OR (100000C), Branch(. + 3, ALU = 0]; 

Skew_ (Skew) OR (40C); *SHA=*T 

BBFIags_(BBFIags) LCY 1; * Exchange source extra - word flags 

T_ (Width) - 1; 

DstX_(Dstx) + T; * Advance to rightmost X - coordinates 

SrcX_(SrcX) + T; 

T_36C; * ALUFM control for "A-1“ 


* Have ALUFM control in Tfor "A + /- 1" operation. 

SetupALU&ShC: 

PD_ (SWidth) -1; * Thin source check (see below) 

NoSrcThinChk: 

Stack& - 4_ALUFMRW_T, A + / - i. * Set ALU function, save old value. 

BranchfSetupShC, ALU#01; * Leave StkP - > TOS (scan line count) 


* If we would have fetched an extra source word, but there is only one source 

* word to fetch, then reset source extra - word flags and set SHA = R, SHB = R. 

BBFIags_A0, Branchf. + 2, R> =0]; 

Skew_ (Skew) AND (17C); 

T_LSH(BBMasks, JO], Branch(. + 2]; * Placement 

* Merge skew with masks and load SHC 
SetupShC: 

T_LSH(BBMasks, 101; 

T_LCY(T, Skew, 101; 

PD_ (Width) - 1,ShC_T; 

* Convert Dstx and SrcX to X word displacements relative to start of 

* first scan line. Note: BBDst is the same register as DstX, and 

* BBSrc is the same register as SrcX. 

BBDst_RSH[DstX, 4], 8ranch[. + 2, ALU > = 0]; * BBDst_DstX/20 

Branch[BitBitDone]; *Width<=0 — nothing to do 

BBSrc_RSH(SrcX, 4]; * BBSrc_ SrcX/20 


* Shift masks to 80 - 7 

* Concatenate SHA, SHB, count, masks 


* Fetch and set up Y - coordinate information 


Fetch_7S; * Fetch DH 

T_M D, Fetch_ 5S; * Fetch DTY 

D$tY_ MD, Fetch_ 13S; * Fetch STY — must be fetched last 

$kew_ (DstY) - MD; * Test and remember vertical direction 

* VCount_ (scan lines left to do) - 1. Stack has scan lines already done. 

VCount_T - (Stack) - 1, Branch[YTopToBottom, ALU <0]; * DH - (scan lines done) -1 

* DTY > = STY, work from bottom to top. Start with lowest line not yet done. 

GrayDirection __ T - T - 1; 

T_(DstY) + 1; WAS: (2c); 

6 ray Offset T; * Offset i nto g ray 

T_ VCount, Branch[YFinlsh]; 

* DTY < STY, work from top to bottom. Start with highest line not yet done. 

YTopToBottom: 

GrayDirection_A0; 

T _ (DstY) + T; 

GrayOffset_T - 1; 

T_Stack; 

YFinish: 

DstY_(DstY) + T; 

SrcY_T + MD; 


* Offset into gray 


* Compute starting Y coordinates 

* MD still has STY 
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* Set up destination base address and increments 


* Compute starting destination scan line offset relative to base of bit map. 

* DstY has scan line number. 

r_ DstY, Fetch_ 3S; * Fetch DBMR 

DRast_ MD, T_AO, Q_T, Branch[. + 2, ALU = 0); * Don't multiply if DstY = 0 

T_DRast, Call[MulSub|; * T„Q_Q*T, clobbers SBTemp 

* Now have 32 - bit offset in T„Q. Add it to bit map base address. 

**** Program around MicroD problem. Desired statement is: 

**** PO_ (BBFunc) AND (20C), DblCall[DFetchB8Long, DFetchBBShort, R < 0|; 

**** but we must actually write: 

PD_(BBFunc) AND (20C), BRGO@(0] RETCL@[3] JCN(44] GPW0@(11400]; 

Set[DFetchBBShortLoc, 1420]; 


*NowT„BBTemp = adjusted base value. 

* Note: Skew < 0 here iff working top - to - bottom. 

MemBase_ BBDstBR, Skew, Branch[DstLoadBR, R <0]; 

* Processing bottom - to - top. 

* Decrease base by 2" 15, and increase initial displacement by 2'15. 

BBTemp_ (BBTemp) - (100000C); 

T_T - 1, XorSavedCarry; 

BBDst_(BBDst) + (100000C); 

DRast_ (OS) - (DRast); * DRast__ - dbmr 

* Now finally ready to load the base register! 

DstLoadBR: 

T _DWidth, BRHi_ T; * DWidth for code below 

BRLO_BBTemp; 

* Compute destination inter - scan - line word address increment. 

* Dstlnc__ DRast + (if left - to - right then - DWidth else DWidth). 

* Also compute first Prefetch offset (from BBDst). 

* - leftmost word on next scan line, even if processing right - to - left. 

* DPrefOffset__ if L-tO- Rthen DRast else DRast - DWidth. 

* Note that DRast already has DBMR or - DBMR as appropriate. T = DWidth. 

BBDisp, BranchfDstincRtoL, R<0]; * Test direction 

DstlncLtoR: 

Dstlnc_ (DRast) - T; * L to R: DRast - DWidth 

DPrefOffset_T_DRast, Branchf. + 3]; 

DstlncRtoL: 

Dstlnc_(DRast) + T; * R to L: DRast + DWidth 

DPrefOffset__ T_ (DRast) - T; 

PrefDst_ (BBDst) + T; * Initial Prefetch address 
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* Set up source base address and increments 


* Is a source block required? if not, skip source setup. 

BBDisp, Branch{88NoSource, Reven]; 

MemBase_ ScratchBR; 

Fetch__ IIS, T_ SrcY; * Fetch SBMR 

* Compute starting source scan tine offset relative to base of bit map. 

* T == ALU = SrcY = starting source scan line number. 

SRast_MD, T_AO, Q_T, Branchf. + 2, ALU = 0]; * Don't multiply if SrcY a 0 

T_SRast, Call[MulSub]; * T„Q __ Q*T, clobbers 8BTemp 

* Mow have 32 - bit offset in T„Q. Add it to bit map base address. 

**** Program around MicroD problem. Desired statement is: 

**** PD_(BBFunc) AND (40C), DbICallfSFetchBBLong, SFetchBBShort, R < 01; 

**** but we must actually write: 

PD_(BBFunc) AND (4QC), BRGO@[0] RETCL@[3] JCN[104] GPW0@[11400]; 

Set[SFetchBBShortLoc, 1440]; 


* Now T„BBTemp = adjusted base value. 

* Note: DRast> =0 here iff working top-to-bottom. 

MemBase_ BBSrcBR, DRast, Branch(SrcLoadBR, R> =0]; 

* Processing bottom - to - top. 

* Decrease base bv 2‘ 15, and increase initial displacement by 2'15. 

BBTemp_(BBTemp) - (100000C); 

T_T - i, XorSavedCarry; 

3BSrc__ (BBSrc) + (IQOOQOC); 

SRast_ (OS) - (SRast); * SRast_ - SBMR 

* Now finally ready to load the base register! 

SrcLoadBR: 

T SWidth, BRHi T; * SWidth for code below 

BRLo_BBTemp; 

* Compute source inter - scan - line word address increment. 

* Srdnc_ SRast + (if left - to - right then - SWidth else SWidth). 

* Also compute first PreFetch offset (from BBSrc). 

* = leftmost word on next scan line, even if processing right - to - left. 

* SPrefOffset_if L - to - R then SRast else SRast - SWidth. 

* Note that SRast already has SBMR or -SBMR as appropriate. T = SWidth. 

88Disp, 8ranch[SrdncRtoL, R< 0]; * Test direction 

SrcIncLtoR: 

Srclnc_(SRast) - T; * L to R: SRast - SWidth 

SPrefOffset __ T_SRast, Branch[. + 3j; 

SrdncRtoL: 

Srclnc_(SRast) + T; * R to L: SRast + SWidth 

SPrefOffset_T_ (SRast) - T; 

PrefSrc_ (BBSrc) + T; * Initial PreFetch address 
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* Final adjustments prior to entering vertical loop 


* Compute fCnt, the initial value of the Cnt register for each loop. 

* lCnt_if DWidth < = 22B then DWidth - 1 else NOT (DWidth - 3) {= 2 - DWidth]. 

* MCount starts out negative (was initialized long ago). 

BBNoSource: 

PD_ (DWidth) - (23C); 

lCnt_T_(DWidth) - 1, Branch[. + 2, ALU < 0); 

ICnt_ (IS) -T; * = (2$) - (DWidth) 

$tack__ (Stack) - 1; 

* Reset ScratchBR to point to gray 

T_Pointers; 

MemBase __ ScratchBR; 

RBase_RBasetGBCAlo]; 

BRLo_GBCAIo; 

BRHi_GBCAhi; 

MemBase_T; 

* Enter vertical loop with (scan lines done) - 1 on TOS and ALU> =0. 

RBase_RBase(BBReg$}, T_AO; 

PD_ Q_ T, Branch(BBVerticalLoopl; * Init gray value to 0 


* xFetchBBShort: 

* Fetch BitBlt short pointer for destination or source 

* Entry: ALU#0 iff alternate bank bit set 

1 T„Q = 32-bit displacement 

* Exit: T„BBTemp = adjusted base address 


Subroutine; 

**** Note; flush absolute placement when MicroD Is fixed **** 

DFetchBBShort: At[DFetchBBShortLoc], * Fetch DBMR 

BBTemp_Q, Fetch__ 2S, DblBranch[BBNormal, BBAlternate, ALU = 0|; 

SFetchBBShort: At[$FetchBBShortLoc], * Fetch SBMR 

BBTemp_Q, Fetch_10S, DblBranch[BBNormai, BBAlternate, ALU = 01; 


BBNormal: 

9BTemp_„ (BBTemp) + MD, RBase_ RBasefAEmRegs); 

T_T + (EmuBRHiReg), XorSavedCarry, Branch[FetchBBRet]; 

KnowRBase(BBRegsJ; 

BBAlternate: 

BBTemp_(BBTemp) + MD, RBase_„ RBase(AEmRegsl; 

T_T + (EmuXMBRHiReg), XorSavedCarry; 

FetchBBRet: 

RBase_ RBasefBBRegsj, Return; 


* xFetchBBLong: 

* Fetch BitBlt long pointer for destination or source 

* Entry: T„Q = 32 - bit displacement 

* Exit: T„BBTemp = adjusted base address 


Subroutine; 

**** Note: flush absolute placement when MicroD is fixed **** 

DFetchBBLong: At(DFetch88ShortLoc, 1], 

BBTemp__ 22C, Branchf. + 21; * Destination long pointer low word 

SFetchBBLong: At($FetchBBShortLoc, 1], 

BBTemp__ 20C; * Source long pointer low word 

BBTemp_(Fetch_BBTemp) + 1; 

BBTemp_, MD, Fetch_ BBTemp; 

BBTemp_(BBTemp) + Q; 

T_T + MD, XorSavedCarry, Return; 


TopLevel; 
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* BitBIt vertical loop (per - scan - line) 

* At top of loop, the following invariants hold: 

* VCount = (number of scan lines remaining) - 1 

* Stack = (number of scan lines done) - 1 

* MemBase = BBDstBR in destination - only cases, BBSrcBR otherwise 

* ALU < 0 iff destination BR displacement has overflowed 

* Vertical loop overhead: 

* 6 cycles for loop control and destination pointer update 

* +4 cycles for source pointer update if source block is used 

* +4 cycles if block is greater than 20B words wide 


BBVerticalLoop: 

VCount, Branch[BBDoneOrOverflow, ALU <0, R<0); 
vcount_ (VCount) - 1; 

* if positive, iCnt has the desired initial value of Cnt (DWidth - i). 

T_NOT (Cnt_ICnt), BranchJSmallBlock, R> * 01; 

* Block greater than one munch wide. Set up separate munch and word counts. 

* T now has DWidth - 3, where DWidth is the number of words in the destination 

* block, including first and last partial words. 

* MCount __ (DWidth - 3}/20 - 1, Cnt _ (DWidth - 3) mod 20 +• 2. 

MCount_ RSH[T, 4]; 

T__T AND(17C); 

T_ T + (2C); 

MCount_(MCount)- 1, Cnt_T; 

* This dispatch goes to one of: GrayDstSetup, 

* SrcDstSetup, or SrcGrayDstSetup. 

SmallBlock: 

3igBDispatch__ BBDisp; 

Stack__ (Stack) + 1, BranchfHorizontalDispj; * Advance scan lines done 


AdvanceSrcDst: 

* Control returns here at the end of individual horizontal loops that 

* involve both source and destination blocks. 

* BBSrc, BBDst point one beyond last word processed. 


T_ Srclnc; 

88$rc_T_(BBSrc) + T; 

PrefSrc_ T + (SPrefOffset); 

T _BBDst, 8ranch{SrcBROverflow, ALU < 0]; 


AdvanceDst: 

* Control returns here at the end of individual horizontal loops that 

* involve only a destination block. 

* BBDst and T point one beyond last word processed. 


BBDst_T_T + (Dstlnc); 

Pref Dst_ T_T + (DP ref Off set), 

DbIBranchfBBReschedPending, BBVerticalLoop, Reschedule]; 


SrcBROverflow: 

BranchfBBDoneOrOverflow]; 


15 


bitbitl.mc 


26-Sep-84 13:16:22 PDT 









* Reschedule pending. See if interrupt is really being requested, 

* and if so, terminate processing and return + 1 from BitBItSub. 

* The calling emulator will process the interrupt and then 

* call BitBItSub again. 

* T * PrefDst here. 

_ _ _ _ _ ____ _ _ __ __ ; _ _ . 

BBReschedPending: 

VCount, RBase_RBase[NWW], Branch(. + 2, R> =01; 

* We just processed the last scan line, so return normally. 

BranchfBitBltDonej; 

* Test NWW to see whether an interrupt is really pending. 

PD_NWW, NoReschedule; 

Branch!. + 2, ALU > 0]; 

* Mo interrupt pending. Restore RBase and ALU and continue vertical loop. 

PD_T, RBase_ RBasefBBRegsJ, BranchtBBVerticalLoopj; 

* Interrupt really pending. Restore clobbered ALUFM locations before 

* taking interrupt. Note: scan line count at TOS is one behind, so fix it. 
BBInitiatelnterrupt: 

T_Stacks + 3_ (Stacks + 3) + 1, RescheduleNow, * Force immediate trap 

8ranch[BitBltDone 1 ]; 


* Either VCount is exhausted or one of the BR displacements overflowed 

* (or conceivably both events occurred at the same time). 

* If VCount is exhausted then return normally; otherwise restart BitBlt. 

* The easiest way to restart is to pretend an interrupt occurred. 

* Mote: scan line count at TOS is one behind. 


BBDoneOrOverfiow: 

VCount. Branch{BitBltDone, ft <01; 

RBase_ RBase(AEmReg$L Branch[B8initiatelnterrupt]; 


* Really done. Set TOS = 0, restore clobbered ALUFM, and return. 


BitBltDone: 

T_Stacks + 3_AO, R8a$e_ RBase(AEmRegsj; 

BitBltDone 1: 

ALUFMRW Stack& + 1. ALUF[17); * Restore ALUF[17J 

ALUFMRW Stack& - 2, A + /- 1; * Restore ALUF borrowed for A +-/- 1 

PD_T, Link_ Stacks-2; 

Subroutine; 

ReturnfALU = 0]; * Return + 2 if done, + 1 otherwise 

TopLevel; 
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* Horizontal loops 


% 

Organization of horizontal (per - word) loops: 

There are a number of variations, depending on the following: 

1. Whether or not a source block is used: 

2. Whether or not a gray block is used; 

3. Whether or not the destination is an operand; 

4. Whether or not the destination is "thin" (one word per scan line); 

There are fewer than 32 total cases because some of these combinations 
cannot occur (for example, no source block and no gray block). 

Each case has a "setup" routine, a "body" routine, and a "finish" routine. 
Many of these routines are shared among cases, and the flow of control 
is determined by a complicated network of dispatches on BBDisp. 

Finish routines exit to the vertical loop by a branch to AdvanceDst or 
AdvanceSrcDst. 

Q is used exclusively to hold the complement of the gray value for the 
current scan line, or zero if gray is not used. 

To reduce miss wait and increase performance, while processing each 
scan line we fall out of the main loop once per munch and Prefetch 
one munch for the next scan line. This strategy depends on the 
assumption that each scan line is less than 100 munches long (for a 100 - row 
cache, which is what the Dorado has at present). Note that Prefetches 
are done left - to - right even if transfers are done right - to - left. 

Note that the current implementation is imperfect in that the last munch 
of the next scan line may not be prefetched, or an extra munch prefetched 
unnecessarily, because the main loop does not terminate at munch boundaries 
but rather at multiples of 20 words from the end of the scan line. 

Also, the first scan line is not prefetched, and a line past the end of 
the last scan line is prefetched unnecessarily. These defects should not 
affect performance noticeably in normal use. 

% 


TopLevel; 

KnowRBasefBBRegsj; 
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% *- 

Case A: dest_gray 

ShC = R straight through. 

BBOp = NOT A. 

Entry point to this code is at GrayDestSetup. 

It dispatches here after setup. 

Timing, per scan line, including vertical loop overhead: 

20 cycles minimum in the normal case 
+ 1 cycle per full word (excluding first and last partial words) 

+ 4 + (2 * # of munches) cycles if block is wider than 20B words 

13 cycles total in the "thin" case 


* T hasflr5t partial word to be stored, and SrcWd has (uncomplemented) 

* gray word. 

GrayBody: BBAtfGrayBodyLoc], 

Q_SrcWd; 

BBDst_(Store_ BBDst) + /-1, DBuf_T, Branch{Gray End, Cnt = 0& - 11; 


Gray Loop: 

BBDst_ (Store_BBDst) + /- 1, DBuf_Q, Branch(GrayLoop, Cnt#0& - 1j; 

GrayEnd: 

MCount_(MCount)- 1, Cnt_17S, 8ranch[Graylast, R<0]; 

PrefDst_(PreFetch_ PrefDst), Carry20, Branch(GrayLoop|; 

Gray Last: 

Fetch_ BBDst, Branch(DstFinish]; 
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%* - 

Case B: dest _ f(gray, dest) 


She = R straight through. 

BBOp is taken from the following table: 


Operation 
source OR dest 
source XOR dest 
NOT source AND dest 


SourceType 

gray 

gray 

gray 


BBOP 

NOT A OR B 
A EQV B 
A AND B 


The gray word is kept in SrcWd and put directly into the shifter. 

Case A also dispatches to one of case B's entry points, GrayDstSetup. 

The setup code dispatches to the correct body routine. 

Timing, per scan line, including vertical loop overhead: 

18 cycles minimum in the normal case 
+ 3 cycles per full word (excluding first and last partial words} 

+ 6 + (2 * # of pages) cycles if data needs to be "touched" 

+•4 + (2 * # of munches) cycles if block is wider than 20B words 


Vo* 


13cyciestotal in the "thin" case 


G rayDstSetup: 8 BAt[G rayDstSetupLoc], 

T_NOT (VCount), RBase_ R8a$e[GrayAddrMask], CailfGetGrayl; 

KnovvR£}ase[BBRegsj; 

MemBase __ BBDstBR; 

SrcWd_NOT T, Fetch_ BBDst; 

* Label the target for the horizontal dispatch, it is never actually reached 

* by the dispatch, since the branch address is modified by BigBDispatch. 

* The instruction so labelled should be on the same page as the actual 

* targets, and it should not otherwise be constrained. 

HorizontalDisp: B8At[HorizontaiDispLoc|, 

PrefDst_(Prefetch_PrefDst), Carry2Q, Branch[DstThin, Cnt = G& - ij; 

* The following dispatch may modify GrayBody to GrayDstBody. 

BigBDispatch_ BBDisp, Branch{, + 2, R<01; 

T_XShMDLMask(SrcWdl, B_ MD, Branch[Gray8odyj; 

T_X$hMDRMask[$rcWdj, B_MD, Branch[GrayBody]; 

* Body routine for case B only. 

GrayDstBody: BBAt(GrayDstBodyLocl, 

BBDst_T_(Store„ BBDst) + /- 1, D8uf__T; 

BBSrc_(Fetch_T)+/- 1, Branch[GrayDstEnd, Cnt = 0&- 1); 

* Inner loop runs with one word fetched ahead (now in MD). 

* BBSrc runs one word ahead of BBDst, 

GrayDstLoop: 

BBSrc_(Fetch_ BBSrc)+ /- 1,T_MD; 

T___ XShiftNoMask[SrcWd}, B_T; 

BBDst_(Store_ BBDst)+ /- 1, DBuf_T, Branch[GrayDstLoop, Cnt#0&- 1]; 

GrayDstEnd: 

MCount_ (MCount)- 1, Cnt_ 17$, Branch(DstFtnish, R<0]; 

PrefDst_(Prefetch_PrefDst), Carry20, Branch(GrayDstLoop|; 

* Store last partial word. This is the tail of case A also. 

* Have already fetched the last word (at BBDst). 

DstFSnish: 

BBDisp, Branch(. +2, R<0]; 

T_XShMDRMa$k[SrcWd], B_ MD, Branch{StoreLastDstl; 

T_XShMDLMask[$rcWd], B_ MD, Branch[StoreLastDst]; 

* Thin destination slice, for cases A and 8. 

DstThin: 

T_XShMDBothMasks[SrcWd], B_ MD; 

StoreLastDst: 

BBDst_ T_ (Store_ BBDst)+ /- 1, DBuf_T, Branch(AdvanceDst}; 
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%*- 

CaseC: dest _ f (source) 

Case D: destf(source, gray) 

BBOp is taken from the following table: 


<Q = 0) 

(Q = 0) 

(Q = NOT gray) 

Q is ORed with shifter output on the AMux. 

Entry points to this code are at SrcDstSetup, SrcDstSetup&Toueh, 

SrcGrayDstSetup, and SrcGrayDstSetup&Touch. They dispatch here after setup. 

Timing, per scan line, including vertical loop overhead: 

25 cycles minimum in the normal case 
+ 4 cycles per full word (excluding first and last partial words) 

+• 12 + (4 * #of pages) cycles if data needs to be "touched" 

+• 1 cycle if 2 source words are required for the first destination word 
+ 3 cycles if gray is required 

+ 4 + (5 * # of munches) cycles if block is wider than 20B words 

17 cycles minimum in the "thin" case 
> 1 cycle if 2 source words are required 
»- 3 cycles if gray is required 

--- 


Operation 

source 

source 

source 


SourceType 
source 
NOT source 
source AND gray 


BBOP 
NOT A 
A 

NOT A 


* Body routine for cases C and D only. 

SrcGrayBody: BBAt[SrcGray8odyloc], 

T_BBDst_(Store_BBDst) + /- 1, DBuf_T, FlipMemBase, 

**** Program around MicroD problem. Desired branch clause is: 

**** Call($rcGrayEnd,CntsO&-1]; 

**** b ut we must ac tual!y write: 

BRGO@[0] RETCL@[2] JCN[43]; 

BBSrc_(Fetch__BBSrc) + /- 1, FlipMemBase. 

BBAtfSrcGrayBodyLoc, 11; **** MicroD problem 
SrcWd_MD, T _SrcWd; 

T_ XShiftNoMask{SrcWdl, A_ Q, Branch(SrcGrayBody]; 

* This is called as a subroutine at the end of each munch. 

* it either exits the horizontal loop or returns to do another munch. 
SrcGrayEnd: 

Subroutine; 

MCount_(MCount)- 1, Cnt__ 17S, 

DblBranch[SrcDstFinish, SrcDstMore, R<0], 
B8At(SrcGrayBodyLoc, 2|; **** MicroD problem 

TopLevel; 
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%* - 

Case E: dest _ f(source, dest) 

Case F: dest _ f($ource, gray, dest) 

BBOp is taken from the following table: 


Operation 

SourceType 

BBOP 


source OR dest 

source 

NOT A OR B 

(Q = 0) 

source XOR dest 

source 

A EQV B 

(Q = 0) 

NOT source AND dest 

source 

A AND B 

(Q = 0) 

source OR dest 

not source 

A ORB 

(Q = 0) 

source XOR dest 

NOT source 

AXORB 

(Q = 0) 

NOT source AND dest 

NOT source 

NOT A AND B 

(Q = 0) 

source OR dest 

source AND gray 

NOT A OR B 

(Q - NOT gray) 

source XOR dest 

source AND gray 

A EQV B 

(Q = NOT gray) 

NOT source AND dest 

source AND gray 

A AND B 

(Q = NOT gray) 


Q is ORed with shifter output on the AMux. 

Cases C and D also dispatch these entry points. 

The setup code dispatches to the correct body routines. 

Timing, per scan line, including vertical loop overhead: 

25 cycles minimum in the normal case 
+- 5 cycles per full word (excluding first and last partial words) 

+-12 + (4 * # of pages) cycles if data needs to be “touched" 

+ 1 cycle if 2 source words required for the first destination word 
+• 3 cycles if gray is required 

* 4 + (5 * # of munches) cycles if block is wider than 20 B words 

17 cycles minimum in the “thin" case 
+• 1 cycle if 2 source words are required 
+• 3 cycles if gray is required 

- 


SrcGrayOstSetup; BBAt(5rcGrayDstSetupLocj, 

T _ NOT (VCount), RBase_ RBase(GrayAddrMask], Call[GetGray]; 
KnowRBaseiBBRegsj; 

MemBase_BBSrcBR; 

Q_T, BBFIags, DblBranch(SrcDstSetup2 / SrcDstSetupl, R<0|; 

SrcDstSetup: BBAt(SrcDstSetupLoc], 

BBFIags, DblBranch[SrcDstSetup2, SrcDstSetupl, R<0|; 

SrcDstSetup2: 

BBSrc_(Fetch_ BBSrc) + / - 1; 

SrcDstSetupl: 

PrefSrc_(PreFetch_ PrefSrc), Carry20; 

T_MD, BBSrc_ (Fetch_BBSrc)+ /- 1, FlipMemBase, 

SrcWd_MD, Fetch_ BBDst; 

PrefDst_(PreFetch__ PrefDst), Carry20, Branch{SrcDstThin, Cnt = 0& - 1); 

* The following dispatch may modify SrcGrayBody to SrcGrayDstBody. 
BigBDi$patch_ BBDisp, Branch[. +2, R<0]; 

T_XShMDLMask[SrcWd], A_ Q, B_ MD, Branch[SrcGrayBody]; 

T_XShMDRMaskfSrcWd], A_ Q, B_ MD, Branch(SrcGrayBody]; 
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Cases £ and F (cont'd) 


* Body routine for cases E and F only. 

SrcGrayQstBody: BBAt(SrcGrayDstBodyLocJ, 

T_B8Dst_(Store_ BBDst)+/- l, DBuf_T, FlipMemBase, 

**** Program around MicroD problem. Desired branch clause is: 

**** Cali[Src6rayDstEnd, Cnt = 0& - 1]; 

**** but we must actually write: 

BRGO@[0] RETCL@[2] JCN(103]; 

BBSrc_(Fetch_8BSrc) + /- 1, FlipMemBase, 

BBAt(SrcGrayDstBodyLoc, 1]; **** MicroD problem 
SrcWd_MD, T_SrcWd, Fetch_ T; 

T_XShiftNoMask(5fcWd], A_Q, B_MD, Branch[SrcGrayDst8odyj; 

* This is called as a subroutine at the end of each munch. 

* It either exits the horizontal loop or returns to do another munch. 

* Note: code following SrcGrayDstMore is used by cases C and D also. 
SrcGrayDstEnd: 

Subroutine; 

MCount_(MCount) - 1, Cnt_17S, 

DblBranch[$rcDstFinish, SrcDstMore, R<0], 
BBAtfSrcGrayDstBodyLoc, 2]; **** MicroD problem 

SrcDstMore: 

PrefSrc_(PreFetch_Pref Src), Carry20; 

FlipMemBase; 

PrefOst_ (PreFetch_PrefDst), Carry2Q; 

FlipMemBase, Return; 

TopLevel; 

* Store last partial word, for cases C, D, E, and F. 

SrcDstFinish: 

8BFIags, Branch{. + 2, R even); * Fetch extra word at end? 

8BSrc_(Fetch_ BBSrc)+ /- 1, FlipMemBase, Branch{. -1-2]; 
FlipMemBase; 

SrcWd_MD, T_SrcWd, Fetch_T; 

BBDisp, Branch{. + 2, R<0|; 

T_XShMDRMaskfSrcWd], A_ Q, B_ MD, Branch[StoreLastSrcDst|; 

T xShMDLMaskfsrcWd], A_ Q, B MD, Branch(StoreLastSrcOst]; 

* Thin destination slice, for cases C, D, E, and F. 

SrcDstThin: 

T___ XShMDB 0 thMasks(SrcWd], A__ Q, B__ MD; 

StoreLastSrcOst: 

BBDst_(Store_ BBDst) + /- 1, DBuf_T. FlipMemBase, 

BranchfAdvanceSrcDst]; 
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* Other subroutines 


GetGray: 

* Get the gray word for the current scan line. 

* Calling sequence: 

* T _ NOT (VCount), RBase_ RBase[GrayAddrMask], Call(6etGray]; 

* Exit: T = complement of gray word 

* RBase = BBRegs 

* Note: returns Gray(n mod 4 or 16), where n is the number of scan lines 

* remaining after the current scan line. Note that VCount = n-1. 


Subroutine; 

KnowRBase(GrayAddrMask); 

Global, 

T T XOR (GrayDIrection); * invert if working bottom - to - top 

T T + (GrayOffset); * Adjust for initial Y 

T_T AND (GrayAddrMask), MemBase _ ScratchBR; 

Fetch _T,T_ AO; 

T_T - (MD) - 1, Rbase_Rbase(BBRegsj, Return; 


END; 

1(1552) 
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-- File: CvSTC.mesa 
-- 11-Sep-89 12:22:22 

-- Last Revised by: Erickson 24-Nov-16:53:30 

-- Owner: Workstation Applications - Foreign Conversion Team 

-- Copyright (c) 1984. 1985. 1986, 1987, 1989 by Xerox Corporation. All rights reserved. 

DIRECTORY 

Converter 

USING [ConvertProc, CvData, DestroyProc, DependentOptionProc, MenuItemProc], 

NSFile 

USING [Reference], 

W 1 ntfow 

USING [Handle], 

XStrlng 

USING [Reader, ReaderBody, Writer]; 


« 


— OVERVIEW: 

Private definitions Interface for the ascii conversion. 

-■•SBausaxss3:a&sssssscsssassss3S3ss2=s== = = = = szsx3'ras = =:x3 

» 

CvSTC: DEFINITIONS = 

BEGIN 


-- CONSTANTS 


stc: CARDINAL = 0; 
etc: CARDINAL = 1; 

modern: CARDINAL = 0; 
classic: CARDINAL. = 1; 

twelve: CARDINAL = 0; 
twentyFour: CARDINAL = 1; 

unlimited: CARDINAL = 0; 
limited: CARDINAL = 1; 

dfltCodeScheme: CARDINAL = stc; 
dfHFont: CARDINAL - modern; 
df1tFontSize: CARDINAL = twelve; 
df1tTralling: BOOLEAN = FALSE; 
df1tTelCodes: BOOLEAN = FALSE; 
dfltLineLen: CARDINAL = unlimited; 
dfltChars: CARDINAL = 80; 
df 1 tWordWrap : BOOLEAN =■ TRUE; 

leadingMargln: CARDINAL = 2; 
pointsBetweenltems; CARDINAL - 10; 


TYPES 


Boolean: TYPE = MACHINE DEPENDENT REC0RD[ 

zeros(0:0..14): [0..7777B], value(0:15..15): BOOLEAN]; 

Common: TYPE = LONG POINTER TO CommonData; 

CommonData: TYPE = RECORD [ 
cvData: Converter.CvData, 
options: BOOLEAN, 
window; Window.Handle, 
owner: Owners, 
ref: NSFile.Reference. 
f: CommonObj, 
textRb; FiledXStrlngs, 
text: EncodedText, 
z; UNCOUNTED ZONE]; 

« 

The same data streture is used by all the client formwlndows/details sections. 

» 

Filed: TYPE = LONG POINTER TO CommonObj: 

CommonObj: TYPE = MACHINE DEPENDENT RECORD [ 
avCodeScheme: CARDINAL «- dfl tCodeScheme , 
font: CARDINAL <- dfltFont, 
fontSize: CARDINAL *■ df ItFontSize, 

IgnoreTrailing: Boolean <- [0, df 1 tTrail ing] . 
incl udeTelCodes: Boolean «- [0, dfl tTelCodes] . 
vaCodeScheme: CARDINAL «■ dfl tCodeScheme , 

1 IneLen: CARDINAL *- dfltLineLen, 
charsSufflx: CARDINAL <- dfltChars, 
wordwrap: Boolean «■ [0, dfl tWordWrap]]; 

« 

This data structure is the filed data object, along with the va< is strings/text Items that come from the formwindows. 

» 

EncodedText: TYPE * ARRAY TextIDs OF LONG STRING; 

<< 

Use long strings Internally, since they are better suited to ASCII text. 
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» 


F11edXStrlngs: TYPE = ARRAY TextIDs OF XStrlng.ReaderBody; 

« 

Filed strings are kept here. 

» 

Owners: TYPE = [AtoVsrc, AtoVdst, VtoAdst, backstop}: 

TextIDs: TYPE = { 
paraEndsWith, 
atovReplaceUnknown, 
endl.ine, 
endPara, 

vtoaReplaceUnknown 

}s 


— SIGNALS 


Problem: SIGNAL [err: ProblemType]; 

ProblemType: TYPE = {obsoleteDataFile, fatalError, doDflts, other}; 


~ PROCEDURES 


AscilToVP: Converter.ConvertProc; 

<< - PROCEDURE [source: NSF1 le. Handle. cvData: Converter.CvData, session: NSFile. Session, srclnstance: LONG POINTER «■ NIL. dstlnstance 
LONG POINTER NIL. background: BOOLEAN <- FALSE] RETURNS [dest: NSFi le .Handle «- L00PH0LE[0]]; 

Exported by CvSTCToVPImpl . 

» 


AsciIToVPSrcOps: Converter.DependentOptionProc; 

<< :a PROCEDURE [options: BOOLEAN «• TRUE, cvData: Converter .CvData, which: Converter .FormatToUse, srcFormat: XStrlng. Reader, destFormat 
XStrlng.Reader, window: Window.Handle, oldlnstance: LONG POINTER «■ NIL] RETURNS [menuItemProc: Converter.MenultemProc. destroy: 
Converter.DestroyProc, Instance: LONG POINTER]; 

Exported by CvSTCToVPImpl . 

» 


Asc iiToVPDstOps: Converter.DependentOptionProc; 

<< :: PROCEDURE [options: BOOLEAN «• TRUE, cvData: Converter.CvData, which: Converter .FormatToUse, srcFormat: XStrlng .Reader, destFormat 
XString.Reader, window: Window.Handle, oldlnstance: LONG POINTER «■ NIL] RETURNS [menuItemProc: Converter.MenuItemProc, destroy: 
Converter.DestroyProc, Instance: LONG POINTER]; 

Exported by CvSTCToVPImpl. 

>> 


CommonMenu: Converter.MenuItemProc; 

« « PROCEDURE [instance: LONG POINTER, menultem: PropertySheet.MenuItemType] RETURNS [ok: BOOLEAN «- TRUE]; 

Exported by CvSTCFWImpl . 

» 


CrenteCommon: PROC [cvData: Converter.CvData, options: BOOLEAN, window: W1ndow.Handle, owner: Owners] RETURNS [my: Common]; --? 
NSFile.Error 
« 

Exported by CvSTCDatalmpl. 

» 


CreateFW: PROC [my: Common, window: Window.Handle, owner: Owners]; 

« 

Exported by CvSTCFWImpl. 

» 


DataFromWindow: PROC [w: Window.Handle] RETURNS [my: Common]; 

« 

Exported by CvSTCMainlmpl 

» 


DataToWIndow: PROC [my: Common, w: Window.Hand!e]; 

« 

Exported by CvSTCMainlmpl 

» 


DestroyCommon: Converter.DestroyProc; 

« * PROCEDURE [Instance: LONG POINTER]; 

Exported by CvSTCDatalmpl . 

» 

GetPreMargin: PROC [item: MessageKey] RETURNS [leads: CARDINAL]; 

« 
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Exported by CvSTCMalnlmpI. 

» 


GetMessage: PROC [msg: MessageKey] RETURNS [msgRb: XString.ReaderBody]; 

« 

Exported by CvSTCMsgFilelmpl. 

» 


InltniedOata: PROC [my: Common]; -- ! NSFile.Error 

« 

Create and Initialize client file. Exported by CvSTCDatalmpl. 

» 


LoadFiledData: PROC [my: Common]; — ! NSF11e.Error. Problem 

« 

Read filed data. Exported by CvSTCDatalmpl. 

» 


Parseltem: PROC [my: Common, r: XString.Reader, item: MessageKey, buf: XString.Writer «■ NIL] RETURNS [ok: BOOLEAN, Is: LONG STRING]; 

« 

Exported by CvSTCParselmpl. If ok is FALSE, error during parse. Is is NIL if Item has null text, buf is a temporary buffer that will 
be created and destroyed each time the proc is called If defaulted, otherwise It will just be used. 

» 


StoreFiledData: PROC [my: Common]; -- ! NSFile.Error 

« 

Write filed data. Exported by CvSTCDatalmpl. 

» 


VPToAscil: Converter.ConvertProc; 

« :s PROCEDURE [source: NSFi le. Handle, cvData: Converter .CvData, session: NSF11 e . Sess Ion , srclnstance: LONG POINTER NIL, dstlnstance: 
LONG POINTER «- NIL, background: BOOLEAN <- FALSE] RETURNS [dest: NSFile .Handle <- LOOPHOLE[0]]; 

Exported by CvSTCFromVPImpl. 

» 


VPToAsciIDstOps: Converter.DependentOptionProc; 

<< ” PROCEDURE [options: BOOLEAN *• TRUE, cvData: Converter.CvData, which: Converter.FormatToUse, srcFormat: XString.Reader, destFormat: 
XString.Reader, window: Window.Handle, oldlnstance: LONG POINTER <- NIL] RETURNS [menuItemProc: Converter.MenuItemProc, destroy: 
Converter.DestroyProc, instance: LONG POINTER]; 

Exported by CvSTCEromVPImpI. 

» 


-- MESSAGES 


MessageKey: TYPE = { 
ascilDoc, 
paraEndsWIth, 
codeScheme, 
codeSchemeCholces, 
font, 

fontCboices. 
fontSize, 
fontSIzeChoices, 
IgnoreTrailIng. 
includeTelCodes, 

1 IneLen, 

1ineLenCholces, 
charsSuffix, 
wordwrap, 
endLine, 
endPara, 
replaceUnknown, 
lastPsheetltem, 
left, 
right, 
cr, 

If, 
nl, 
ff, 
tab, 

createError, 

notPF, 

paginating, 

sk ippedTableData, 

df1tAVEndParagraph, 

df1tAVReplaceCharacter, 

prefix, 

doneFailed, 

backstop, 

metaError, 

charsOutOfBounds, 

fatal Error, 

extraErrO, 

extraErrl, 

df1tVAEndLine, 

df1tVAEndParagraph, 
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dfltVAReplaceCharacter}; 


END. 


LOG 

5-Dec-84 15:01:26 
19-Dec-84 15:31:39 
16-Apr-85 10:40:52 
28-May-85 9:23:59 
26-Fel>-87 16:17:12 
18-Mar-87 14:02:39 
24-Nov-87 16:51:13 


MSchnelder.pa - CREATED 
MSchnelder - update to BWS 4.0 

MSchnelder - added some comments and owner statement 
MSchnelder - took out messages now in common interface 
Caro - Added paginating and spares 
Caro - Completely rewritten for Enhancements I 

Erickson - added aToVDf1tMeta to change A to V paraEndsWith default 
from <CRXLF> to <CR> 
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— File: CvSTCDatalmpl.mesa 
-- Trow ll-Sep-89 12:42:03 

Last Revised by: Erickson 24-Nov-87 16:54:21 

-- Owner: Workstation Applications - Foreign Conversion Team 

Copyright (c) 1987, 1989 by Xerox Corporation. All rights reserved. 

DIRECTORY 

Courier 

USING [Description, DeserializeParameters, Error, Free, 

Parameters, SerialIzeParameters], 

Converter 

USING [CreatedientFIle, CvData, DestroyProc, FindCllentFIle] , 

ConverterMsg 

USING [Get, kvpDocument], 

CvSTC 

USING [Common, CommonData, CommonObj, 

GetMessage, Owners, Problem, TextlDsj, 

Environment 

USING [bytesPerPage], 

Heap 

USING [Create, Delete], 

NSFile 

USING [Delete, Error, Handle, nullReference, OpenByReference], 

NSF11eStream 

USING [Create, GetLength, Handle, SetLength], 

Stream 

USING [Delete, InvalIdOperatlon], 

W1ndow 

USING [Handle], 

X,String 

USING [CopyToNewReaderBody, DescrlbeReaderBody, nullReaderBody, ReaderBody]; 


« 

-- OVERVIEW: 

Data and filed data procedures 


» 


CvSTCDatalmpl: PROGRAM 
IMPORTS 

Converter, ConverterMsg, Courier, CvSTC, Heap, 
NSFile, NSFileStream, Stream, XString 
EXPORTS 
CvSTC » 

BEGIN 


— CONSTANTS 


keyflits: Key = 2707974433; —/* never change this value! V 

currentVersion: Version = 3; --/* change this value if you alter the filed data format */ 


-- History of Versions (update each time version number changes) 
-- X8-Mar-87 11:48:29 - 1 - First version 

-- X2-Feb-89 19:15:55 - 2 - STC version 

-- ll-Sep-89 12:23:12 - 3 - STC version 


TYPES 


Key: TYPE = LONG CARDINAL: 
Version: TYPE = INTEGER; 


-- PUBLIC PROCEDURES 


CreateCommon: PUBLIC PROC [cvData: Converter.CvData, options: BOOLEAN, window: Window.Handle, owner: CvSTC.Owners] RETURNS [my: 
CvSTC.Common] = { 

z: UNCOUNTED ZONE «- Heap.Create[Initial : 16, Increment: 28]; 

my <- z.NEW[CvSTC .CommonData «■ [ 
cvData: cvData, 
options: options, 
window: window, 
owner: owner, 
ref: NSFlle.nullReference, 
textRb: ALL[XString.nullReaderBody], 
text: ALL[NIL], 

z: O]: 

--/+ find client file */ 

BEGIN 

ENABLE UNWIND => Heap.Delete[z]; 
prefix: XStri ng. ReaderBody *■ CvSTC .GetMessage[pref ix] ; 
src: XString. ReaderBody «- CvSTC ,GetMessage[asci iDoc] ; 
dst: XString. ReaderBody «■ ConverterMsg ,Get[ConverterMsg. kvpDocument] ; 
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my. ref «■ Converter.FIndClientFile[ 
cvData: cvData, 
srcFormat: ©src, 
destFormat: ©dst, 
prefix: ©prefix]; 

IF my.ref = NSFile.nullReference THEN 

{ 

--/* file never created, so Initialize */ 
InitFIledData[my] ; --/* fills In my.ref */ 

}: 


-■■/* read data */ 

be:gin 

ENABLE CvSTC.Problem *> 

c 

file: NSFile .Handle «■ NSFile .OpenByReference[my. ref] ; 
--/* get rid of old file, reinitialize */ 

NSFile.Delete[file]; 

InitF11edData[my]; 

CONTINUE; 

}: 

LoadF11edOata[my]; 

END; 

END; 

}; 


DestroyCommon: PUBLIC Converter.DestroyProc = { 
« a PROCEDURE [instance: LONG POINTER]; 

» 

my: CvSTC.Common *• instance; 
z: UNCOUNTED ZONE; 

IF my = NIL THEN RETURN; 
z «* my .z; 

Heap.Delete[z]; 


InitFIledData: PUBLIC PROC [my: CvSTC.Common] = { 
myObj: CvSTC.CommonData; 

avPara: XStrlng . ReaderBody «■ CvSTC .GetMessage[df 1 tAVEndParagraph] ; 
avChar: XString .ReaderBody *■ CvSTC .GetMessage[df 1 tAVReplaceCharacter] ; 
vaLlne: XString . ReaderBody «■ CvSTC .GetMessage[df 1 tVAEndLine] ; 
vaPara: XString. ReaderBody «■ CvSTC,GetMessage[df 1 tVAEndParagraph]; 
vaChar: XString. ReaderBody «* CvSTC.GetMes$age[dfltVARepl aceCharacter] ; 

—/* make dummy filed data */ 
myObj.textRb «■ my.textRb «• [ 
paraEndsWIth: avPara, 
atovReplaceUnknown: avChar, 
endLlne: vaLlne, 
endPara: vaPara, 
vtoaReplaceUnknown: vaChar]; 
myObj.text * ALL[NIL]; 

—/* create client file */ 

BEGIN 

prefix: XString .ReaderBody <- CvSTC .GetMessage[pref lx] ; 

src: XString .ReaderBody *■ CvSTC.GetMessage[asc1 IDoc] ; 

dst: XString .ReaderBody <- ConverterMsg .Get[ConverterMsg . kvpDocument] ; 

my.ref <- Converter .Created ientFlle[ 
cvData: my.cvData, 
srcFormat: ©src, 
destFormat: ©dst, 
prefix: ©prefix]; 

END; 

myObj .ref <- my. ref; 
myObj .z «- my.z; 

myObj.owner <- backstop; —/* let StoreFIledData know we are initializing */ 
—/* store */ 

StoreFiledData[@myObj]; 


LoadFIledOata: PUBLIC PROC [my; CvSTC.Common] = { 
sh: NSFlleStream.Handle «■ [NIL]; 
file: NSFIle.Nandie; 
parms: Courier.Parameters; 
tz: UNCOUNTED ZONE «■ NIL; 

—/* read filed data */ 

BEGIN 

ENABLE 

{ 

Courier.Error, Stream.InvalidOperation => NSFile.Error[[access[fileDamaged]]]; 
UNWIND => 

{ 

IF sh # NSFlleStream.Handle[NlL] THEN Stream.Delete[sh] ; 

IF tz # NIL THEN Heap.Delete[tz]; 

}; 

}: 
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--/* open data file */ 

file *■ NSF11e.OpenByReference[my,ref]; 

—/* open read stream on data file */ 

sh <- NSF11eStream.Create[f11e: file, closeOnDelete: TRUE]; 

—/* create temporary zone for disjoint data */ 

tz «• Heap.Create[(NSF1IeStream.GetLength[sh]/Env1ronment.bytesPerPage) + 2] 

--/* read key V 

BEGIN 

key: Key; 

parms «• [location: @key, description: DescribeKey]; 

Courier.Deserlal1zeParameters[parms, sh, tz]; 

IF key # keyBIts THEN 

{ 

--/* quit */ 

Courier.Free[parms, tz]; 

Stream.Delete[sh]; 
sh <- [NIL]; 

SIGNAL CvSTC.Problem[obsoleteDataF11e]; 

}: 

Courier.Free[parms, tz]; 

END; 

--/* read version */ 

BEGIN 

ver: Version; 

parms <- [location: @ver, description: DescribeVersion]; 

Courier.Deserlal1zeParameters[parms, sh, tz]; 

IF ver ft currentVersion THEN 

c 

—/* quit */ 

Courier.Free[parms, tz]; 

Stream.Delete[sh]; 
sh «• [NIL]; 

SIGNAL CvSTC.Problem[obsoleteDataF11e]; 

}: 

Courier.Free[parms, tz]; 

END; 

--/* read commonObj +/ 

parms *■ [location: @my.f, description: DescrlbeCommonOb j]; 

Courier,Deserial1zeParameters[parms, sh, tz]; 

--/* read paraEndsWIth */ 

BEGIN 

rb: XString.ReaderBody; 

parms «- [location: @rb, description: XString.DescrlbeReaderBody] ; 

Courier.Deserlal1zeParameters[parms, sh, tz]: 

my. textRb[para£ndsW1 th] «- XString .CopyToNewReaderBody[@rb , my.z]; 

Courier.Free[parms, tz]; 

END; 

—/* read atovReplaceUnknown */ 

BEGIN 

rb: XString.ReaderBody; 

parms «■ [location: Orb, description: XString .DescrlbeReaderBody]; 

Courier.Deserlall 2 eParameters[parms, sh. tz]; 

my.textRb[atovReplaceUnknown] «- XString.CopyToNewReaderBody[@rb. my.z]; 
Courier.Free[parms, tz]; 

END; 

--/* read endLine */ 

BEGIN 

rb: XString.ReaderBody; 

parms *■ [location: Qrb, description: XString.DescribeReaderBody]; 

Courier.Deserlal1zeParameters[parms, sh, tz]; 

my. textRb[endLine] «- XString.CopyToNewReaderBody[@rb , my.z]; 

Courier.Free[parms, tz]; 

END; 

--/* read endPara */ 

BEGIN 

rb: XString.ReaderBody; 

parms *■ [location: @rb, description: XString.DescribeReaderBody]; 

Courier.DeserlalizeParameters[parms. sh, tz]; 

my. textRb[endPara] <- XString .CopyToNewReaderBody[@rb , my.z]; 

Courier.Free[parms, tz]; 

END; 

--/* read vtoaReplaceUnknown */ 

BEGIN 

rb: XString.ReaderBody; 

parms *■ [location: @rb, description: XString .DescribeReaderBody]; 

Courier.Deserial1zeParameters[parms, sh, tz]; 

my . textRb[vtoaReplaceUnknown] *• XString.CopyToNewReaderBody[@rb, my.z]; 
Courier.Free[parms, tz]; 

END; 
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END; 

-■-/* clean up */ 
Stream.Delete[sh]; 
Heap.Delete[tz]; 


-- StoreFIledData 

-- * This is tricky, since common data is used. This routine could be called 
+ three different times, with different subsets of data, but the whole 
-- * file must be written each time. 


StoreFIledData: PUBLIC PROC [my: CvSTC.Common] = { 
dataFile: NSFile.Handle; 
sh: NSFileStream.Handle; 
parms: Courier.Parameters; 
tmpMy: CvSTC.CommonData; 

--7* fill out dummy */ 
tmpMy myr; 

IF my.owner tt backstop THEN 
LoadF11edData[@tmpMy]; 

--/* open data file V 

dataFile «■ NSFile.OpenByReference[my . ref ] ; 

—/* open stream on file */ 

sh +■ NSFileStream ,Create[file : dataFile, cl oseOnDel ete : TRUE]; 

NSFileStream.SetLength[fileStream: sh, lengthlnBytes: 0]; 

—/* write data */ 

BEGIN 

ENABLE 

{ 

Courier.Error, Stream.InvalIdOperation => NSFile.Error[[access[flleDamaged]]]; 
UNWIND => Stream.Delete[$h]; 

}; 

--/* write key */ 

BEGIN 

key; Key «- keyBIts; 

parms <■ [location: ©key, description: DescrlbeKey]; 

Courier.SerializeParameters[parms, sh]; 

END; 

--/* write version */ 

BEGIN 

ver: Version «- currentVersion; 

parms «- [location: ©ver, description: DescribeVersIon]; 

Courier.Serial 1zeParameters[parms, sh]; 

END; 

--/* update portions of data record ♦/ 

SELECT my.owner FROM 
AtoVsrc => 

c 

tmpMy.textRb[paraEndsW1th] *- my. textRb[para£ndsWi th] ; 
tmpMy.f.avCodeScheme *• my. f. avCodeScheme ; 

}: 

AtoVdst = > 

c 

tmpMy.f.font *■ my.f.font; 
tmpMy.f.fontSize <- my.f.fontSize; 

tmpMy. textRb[atovReplaceUnknown] *• my.textRb[atovReplaceUnknown] ; 
tmpMy. f. IgnoreTrai 11 ng *■ my . f. ignoreTrall ing ; 
tmpMy.f. includQTelCodes <- my .f. IncludeTelCodes ; 


tmpMy.f.vaCodeScheme *■ my.f.vaCodeScheme; 

tmpMy .f. 1 ineLen «■ my.f .line Len; 

tmpMy .f.charsSuff ix «- my.f, charsSuff ix ; 

tmpMy. f .wordwrap *■ my. f .wordwrap ; 

tmpMy. textRb[endL1 ne] *- my . textRb[endl.ine] ; 

tmpMy. textRb[endPara] «- my. textRb[endPara] ; 

tmpMy. textRb[vtoaRepl aceUnknown] *- my. textRb[vtoaRepi aceUnknown] ; 

ENDCASE; 

--/* write filed data record */ 

parms +* [location: ©tmpMy.f, description: DescribeCommonObj] ; 

Courier.SerializeParameters[parms, sh]; 

--/* write paraEndsWith string */ 

parms *- [location: ©tmpMy,textRb[paraEndsWith], description: XStrlng.DescrlbeReaderBody]; 
Courier.Serial 1zeParameter$[parms, sh]: 

--/* write atovReplaceUnknown string ♦' 

parms «- [location: ©tmpMy,textRb[atovReplaceUnknown], description: XString.DescrlbeReaderBody]: 
Courier.SerializeParameters[parms, sh]; 
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---/* write endLine string */ 

parms «- [location: QtmpMy . textRb[endL1ne] , description: XString.DescrlbeReaderBody]; 

Courier,Serial1zeParameters[parms, sh]; 

-•■/* write endPara string V 

parms «- [location: QtmpMy.textRb[endPara], description: XStrlng.DescribeReaderBody]; 

Courier.SerializeParameters[parms, sh]; 

-*■/* write vtoaReplaceUnknown string + / 

parms «■ [location: QtmpMy.textRb[vtoaReplaceUnknown], description: XStrlng.DescribeReaderBody]; 
Courier.Serial1zeParameters[parms, sh]; 

END; 

Stream.Delete[sh]; 

}; 


— PROCEDURES 


DescrlbeKey: Courier.Description = { 

p: LONG POINTER TO Key = notes.noteS1ze[SIZE[Key]]; 
notes.noteLongCard1nal[p]: 

}; 


DeserlbeVersion: Courier.Description = { 

p: LONG POINTER TO Version = notes.noteS1ze[SIZE[Version]]; 

}s 


DescrlbeCommonObj: Courier.Description = { 

p: LONG POINTER TO CvSTC.CommonObj = notes.noteSize[ 
SIZE[CvSTC.CommonObj]]; 

}; 


END„ . . 

LOG 

16-Mar-87 14:06:16 - Caro - Created 

24-Mov-87 16:55:56 - Erickson - Changed default setting of paraEndsWith 
to <CR> Instead of <CRXLF> 
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-- File: CvSTCFromVPImpl.mesa 

— USep-89 12:32:11 

-- Last Revised by: Caro 16-Sep-87 12:21:45 

-- Owner: Workstation Applications - Foreign Conversion Team 

— Copyright (c) 1987, 1989 by Xerox Corporation. All rights reserved. 

DIRECTORY 
AscI1 

USING [CR, FF, LF, SP, TAB], 

BackgroundProcess 
USING [UserAbort], 

BWSZone 

USING [logonSesslon, Permanent], 

Catalog 

USING [GetFile], 

Converter 

USING [ConvertProc, CvData, DependentOptionProc, DestroyProc, MenuItemProc, 
PostMessage], 

ConvertsrMsg, 

CvSTC 

USING [Common, CommonMenu, CreateCommon, CreateFW, 

DestroyCommon, GetMessage, limited, MessageKey, Owners, 

Parseltem, Problem, stc, unlimited], 

DocInterchangeDefs 

USING [Close, Doc, Enumerate, EnumProcsRecord, Error, NewParagraphProc, 
Open, OpenStatus, PFCProc, PageBreakProc, TextProc], 

Environment 
USING [wordsPerPage], 

NSAssignedTypes 

USING [tUnspeclfled], 

NSFile 

USING [Attribute, Create, Close, Delete, Error, Filter, Find, GetReference, 
Handle, nullHandle, nulIReference, OpenByReference, Reference, Session], 
NSFileStream 

USING [Create, Handle], 

NSString 

USING [FreeString, String], 

Space 

USING [ScratchMap], 

StarFIleTypes 
USING [text]. 

Stream 

USING [EndOfStream, GetWord, PutChar, Delete], 

String 

USING [AppendDedmal, MakeStrlng], 

TIP 

USING [UserAbort], 

XChar 

USING [Character, Code, not, Set], 

XMessage 

USING [MsgKey], 

XStrlng 

USING [FromSTRING, InvalidEncod1ng, NSStrlngFromReader, Reader, ReaderBody, 
Map, MapCharProc]: 


« 


-- OVERVIEW: 

VP to Telegraph Code conversion. 


» 

CvStCFromVPImpl: PROGRAM 
IMPORTS 

BackgroundProcess, BWSZone, Catalog, Converter, ConverterMsg, CvSTC, 
DocInterchangeDefs, NSFile, NSFileStream, NSString, Space, Stream, String, 
TIP, XChar, XStrlng 
EXPORTS 
CvSTC = 

BEGIN 


tablnterval: CARDINAL = 8; 

setMapSize: CARDINAL = SIZE[VPToA$c1ISetMap]; 
charMapSize: CARDINAL = SIZE[VPToAsciICharMap]; 

-- TYPES 


VADgita: TYPE = LONG POINTER TO VADataObj; 

VADataObj: TYPE = RECORD [ 
source: NSFile.Handle, 

output: NSFileStream,Handle, --/+ created from dest */ 

cvData: Converter.CvData, 

session: NSFile.Session, 

dst: CvSTC.Common, 

background: BOOLEAN, 

doc: DodnterchangeDefs.DOC, 

putc: PutCProc, 
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flrstPara: BOOLEAN, 
line: LONG STRING, 

—/ + 

line buffer */ 

n: CARDINAL, 

—/* 

Index of next char in line buffer */ 

pos: CARDINAL, 

—/* 

current position on virtual line +/ 

max: CARDINAL, 

—/* 

last column In line ♦/ 

1astWhite: CARDINAL, 

—/* 

last white */ 

wordwrap: BOOLEAN, 
after: CARDINAL, 

—/* 

number of eop strings to output ♦/ 

z: UNCOUNTED ZONE]; 

--/* 

for previous paragraph +/ 


PutCProc; TYPE = PROC [va: VAData, c: CHARACTER]; 

VPToAsciISetMap: TYPE = ARRAY [0..256) OF LONG POINTER TO VPToAsciICharMap; 
VPToAsciICharMap: TYPE = ARRAY [0..256) OF CARDINAL; 


— GLOBALS 


Global: TYPE = RECORD [ 

prc: LONG POINTER TO VPToAsciISetMap, 
roc: LONG POINTER TO VPToAscliSetMap, 
gz: UNCOUNTED ZONE]; 

g: Global ; 

tct; LONG POINTER TO VPToAscliSetMap; 


— PUBLIC PROCEDURES 


VPToAsci1: PUBLIC Converter.ConvertProc = { 

« » PROCEDURE [source: NSFi 1 e. Handl e, cvData: Converter .CvData , session: NSFIle. Session, srclnstance: LONG POINTER <- NIL, dstlnstance: 
LONG POINTER <- NIL, background: BOOLEAN <- FALSE] RETURNS [dest: NSFi 1 e .Handl e *■ LOOPHOLE[Q]]; 

» 

ENABLE CvSTC.Problem, NSFile.Error, XStrlng.InvalIdEncoding => 

i 

msgRb: XStrlng .ReaderBody *■ CvSTC .GetMessage[fatal Error] ; 

Post[msgRb, cvData]; 

CONTINUE; 

}; 


IF source = NSFile.nullHandle THEN RETURN; 

dest <■ VtoA[source, cvData, session, srclnstance, dstlnstance, background]; 


« 

This DependentOptionProc creates Instance data with CreateCommon. The data is distinguished by the owner variable. The CommonObj within 
CvSTC.CommonData is the data structure written to the client file stored as the Icon properties. Only those fields pertaining to the 
owner are used. 


» 


VPToAsciiDstOps: PUBLIC Converter.DependentOptionProc = { 

<< Si PROCEDURE [options: BOOLEAN «■ TRUE, cvData: Converter.CvData, which: Converter, FormatToUse, srcFormat: XStri ng. Reader, destFormat: 
XStrlng.Reader, window: Window.Handle, oldlnstance: LONG POINTER <- NIL] RETURNS [menuItemProc: Converter.MenuItemProc. destroy: 
Converter.DestroyProc, Instance: LONG POINTER]; 

» 

owner: CvSTC.Owners «• VtoAdst; 

menuItemProc «- CvSTC.CommonMenu; 
destroy *■ CvSTC. DestroyCommon ; 

IF oldlnstance * NIL THEN 

Instance «■ CvSTC .CreateCommon[cvData, options, window, owner ! NSFile.Error, CvSTC. Probl em => (owner «■ backstop; Instance +■ NIL; 
CONTINUE}] 

ELSE 

C 

my: CvSTC.Common *■ oldlnstance; 

my.window +■ window; --/* AR 13535: update window handle */ 

Instance *■ my; 

}: 


--/* make formwindow */ 

CvSTC,CreateFW[1nstance, window, owner]; 

}s 


-- PROCEDURES 


VtoA: Converter.ConvertProc * { 
aborted: BOOLEAN «- FALSE; 
dataSkipped: BOOLEAN «• FALSE; 

attr: ARRAY [0..1) OF NSF11 e . Attribute *- [[type[StarFileTypes.text]]]; 
enumProcs: DocInterchangeDefs. EnumProcsRecord *■ [ 
newParagraphProc: EndPrevAsciiPara, 
pageBreakProc: AddAsciiPage, 
textProc: AddAsciiText, 
pfcProc: AddAsciiPFC]; 
openStatus: DocInterchangeDefs.OpenStatus; 
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vaData: VADataObj; —/* only works If Enumerate doesn’t FORK */ 
dst: CvSTC.Common «■ NIL; 


--•/* Initialize instance data */ 

IF dstlnstance = NIL THEN 

{ 

ENABLE NSFIle.Error, CvSTC.Problem => 

{ 

msgRb: XString.ReaderBody «• CvSTC.GetMessage[extraErrO]; —" Unrecoverable ASCII conversion error: damaged converter icon. 

Converter.PostMessage[ 
msg: QmsgRb, 
cvData; cvData, 
cr: FALSE, 
clear: FALSE]; 

GOTO terminate; 

}; 

key: CvSTC.MessageKey <• CvSTC.MessageKey.FIRST; --/* dummy */ 

--/* we only care about dst */ 

dst «• CvSTC .CreateCommon[cvData, FALSE, NIL, VtoAdst]; 

dst.text[endL1ne] <- CvSTC.Parseltem[ 
my: dst, 

r: @dst.textRb[endLine], 
item: key].ls; 

dst.text[endPara] «• CvSTC . Parseltem[ 
my: dst, 

r: @dst.textRb[endPara], 
item: key].ls; 

dst.text[vtoaReplaceUnknown] <- CvSTC.Parseltem[ 
my: dst, 

r: @d$t.textRb[vtoaReplaceUnknown], 
item: key].Is; 

EXITS terminate => RETURN; 

} 

ELSE 

c 

dst <■ dstlnstance; 

}; 

vaData «- [ 

source: source, 
output: [NIL], 
cvData: cvData, 
session: session, 
dst: dst, 

background: background, 
doc: TRASH, 

putc: IF dst.f.UneLen = CvSTC.uni 1raited THEN UnbufferedPutC ELSE BufferedPutC, 

flrstPara: TRUE, 

line: NIL, 

n: 0, 

pos: 0, 

max: 0, 

lastWhite: CARDINAL.LAST, 
wordwrap: dst .f .wordwrap.value, 
after: 0, 
z: dst.zj; 

IF dst.f .lineLen => CvSTC . 1 imi ted THEN 

{ 

—/* ASSERT: charsSuffix IN [10..256] */ 

—/* create line buffer */ 

vaData.line <- Stri ng .MakeStr ing[z: vaData.z, maxlength: dst.f .charsSuffix]; 
vaData.1ine.1ength * vaData.1ine.maxlength; 
vaData.max *■ dst.f.charsSuffix 1: 

IF dst.text[endL1ne] # NIL AND dst.text[endLine].1ength < vaData.max THEN 

{ 

—/* max column is limit less visible end-of-11ne characters */ 

FOR i: CARDINAL IN [0..dst.text[endLine].1ength) DO 
SELECT dst.text[endLine][i] FROM 

Ascii.CR, Ascii.LF, Ascii.FF => NULL; 

ENDCASE => vaData.max *- vaData.max - 1; 

ENDLOOP; 

}; 

}; 


IF dst.f.vaCodeScheme = CvSTC.stc THEN tct *■ g.prc ELSE tct *• g.roc; 

BEGIN 

ENABLE 

c 

NSFile.Error => GOTO nsErr; 

DocInterchangeDefs.Error => GOTO docErr; 

UNWIND => IF dstlnstance = NIL THEN 

C 

CvSTC.DestroyCommon[d$t]; 
dst *■ NIL; 

}; 


[vaData.doc, openStatus] *■ DocInterchangeDefs.Open[ 

docFileRef: NSFile.GetReference[source, vaData.session], 
session: vaData.session]; 

IF openStatus # ok THEN GOTO docErr; 
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dest «■ NSFIle .Createf 

directory: NSFIle.nullHandle, 
attributes: DESCRIPTOR[attr], 
session: session f NSFIle.Error a > { 

IF error = [space[mediumFul1]] THEN 

Po$t[ConverterMsg.Get[ConverterMsg.koutOfSpace], vaData.cvData] 

ELSE 

Post[CvSTC,GetMessage[createError], vaData.cvData]; 

GOTO nsErr}]; 

vaData.output «• NSFtleStream.Create[ 
file: dest, 
closeOnDelete: FALSE, 
session: vaData.session]; 

dataSklpped «• OocInterchangeDefs .Enumerate[ 
textContalner: [docfvaData.doc]], 
procs: SenumProcs, 
clientData: QvaData ! ABORTED => { 
dataSklpped «• TRUE; 
aborted «■ TRUE; 

Post[ConverterMsg.Get[ConverterMsg.kuserAbort], vaData.cvData]; 

CONTINUE}]; 

—/* AR 13705; flush any remaining text */ 

—/* ASSERT: n = 0 IF dst.f.1IneLen » CvSTC.1imited +/ 

IF NOT aborted AND vaData.n > 0 THEN 

{ 

RawPuts[@vaData, vaData.line, vaData.n]; 

—/* AR 14393: terminate last paragraph */ 

RawPuts[@vaData, vaData.dst.text[endPara]] ; 

); 

Stream.Delete[vaData.output ! NSFIle.Error => { 

IF error = [space[med1umFul1]] THEN 

Post[ConverterMsg.Get[ConverterMsg.koutOfSpace], vaData.cvData] 

ELSE 

Post[ConverterMsg,Get[ConverterMsg.kunknownProblem], vaData.cvData]; 

WSFile.Delete[dest, vaData.session]; 
dest <■ NSFIle.nullHandle; 

GOTO nsErr}]; 

IF dataSklpped THEN 

Post[ConverterMsg.Get[ConverterMsg.kdataSkipped], vaData.cvData]; 
DocInterchangeDefs.Close[@vaData.doc]; 

EXITS 

nsErr => { 

IF vaData.doc # NIL THEN 

DocInterchangeDefs.Close[@vaData.doc ! OocInterchangeDefs.Error *> CONTINUE]}; 
docErr => { 

key: XMessage .MsgKey <- 
SELECT openStatus FROM 

malFormed, incompatible => ConverterMsg.klncompatible, 
outOfDiskSpace, outOfVM => ConverterMsg.koutOfSpace, 

ENDCASE => ConverterMsg.kcantOpen; 

Post[ConverterMsg.Get[key], vaData.cvData]; 

IF vaData.doc # NIL THEN 

DocInterchangeDefs.ClosefOvaData.doc ! OocInterchangeDefs.Error => CONTINUE]; 
dest +■ NSF11 e . nullHandle}; 

END; 

IF vaData.line ft NIL THEN vaData. z .FREE[@vaData. 1 ine] ; 

--/* destroy Instance data If created by this proc */ 

IF dstlnstance = NIL AND dst ff NIL THEN CvSTC.DestroyCommon[dst] : 


Post: PROC [msgRb: XStrlng.ReaderBody, cvData: Converter.CvData] = { 
Converter. PostMessage[ 
msg: QmsgRb, 
cvData: cvData, 
cr: TRUE, 
clear: FALSE]; 

h 


CheckAbort: PROC [background: BOOLEAN] RETURNS [yes: BOOLEAN] a INLINE ( 
yes *■ (background AND BackgroundProcess .UserAbort[]) OR 
(NOT background AND TIP.UserAbort[NIL]); 

}: 


--/* Enumeration Procs */ 

AddAsciiPage: DocInterchangeDefs.PageBreakProc - { 

<< = PROCEDURE [clientData: LONG POINTER, fontProps: DocInterchangePropsDefs.ReadonlyFontProps] RETURNS [stop: BOOL *■ FALSE]; 

» 

va: VAData *- clientData; 

— form feed appended for a new page 
va.putc[va, Ascii.FF]; 

}: 


EndPrevAsc1iPara: DocInterchangeDefs.NewParagraphProc = { 

<< = PROCEDURE [clientData: LONG POINTER, fontProps: DocInterchangePropsDefs.ReadonlyFontProps, paraProps: 
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DocInterchangePropsDefs.ReadonlyParaProps] RETURNS [stop: BOOL «■ FALSE]; 

» 

va: VAOata <- clIentData; 

--/* ASSERT: n M IF dst.f.1IneLen » CvSTC.limited */ 

IF va.n > 0 THEN RawPuts[va, va.line, va.n]; --/* flush any pending text */ 

--/+ a new para char means we terminate the previous ASCII paragraph */ 

IF va.firstPara AND paraProps.basIcProps,preLeadlng < paraProps.basicProps,1IneHeight THEN 
va.firstPara <- FALSE 

ELSE 

{ 

—/* ceiling to next highest line */ 
newlines: CARDINAL *• 

(paraProps.basicProps.preLeadlng + paraProps.basicProps.1IneHeight - 1) / 

paraProps.basicProps.1IneHeight; 

IF NOT va.firstPara THEN 

{ 

--/* end previous paragraph */ 

RawPuts[va, va.dst.text[endPara]]; 

—/* append endLine strings for AFTER paragraph spacing */ 

THROUGH [1..va.after] DO 

RawPutsfva, va .dst. textfendLlne]]; 

ENDLOOP; 

}; 


--/+ this newPara character contains properties for the FOLLOWING * 

—/* paragraph, therefore output BEFORE line spacing first */ 

THROUGH [1..new!ines] DO 

RawPuts[va, va.dst.text[endL1ne]]; 

ENDLOOP: 

va.firstPara «* FALSE; 

}: 

va.n <- 0; —/* reset line Index */ 

va.pos «- 0; --/* reset line position V 

va.lastWhite *• CARDINAL.LAST; --/* reset last white */ 

--/* save AFTER line spacing */ 
va.after <- 

(paraProps.basicProps.postLeading + paraProps.basicProps.1IneHeight - 1) / paraProps.basicProps.1IneHeight: 


AddAscilPFC: DocInterchangeDefs.PFCProc 3 {}; 

« 


AddAsciiText 

This procedure does the bulk of the text handling. Its main purpose Is to translate VP characters into ASCII characters, according to 
the user's encoding selection. 

— — sa:ss = cs = = = = sBssss = 3ssass-zss = s3s3scsssxss = = s32szxx = aaxs3asaaiB3aasBBBsaB333S3x* 

» 


AddAscilText: DocInterchangeDefs.TextProc = { 

<< » PROCEDURE [clIentData: LONG POINTER, fontProps: DocInterchangePropsDefs.ReadonlyFontProps , text: XStrlng.Reader, textEndContext: 
XStrlng.Context] RETURNS [stop: BOOL «- FALSE]; 

» 

va: VAData = clIentData; 


—/* local procs */ 

XnToXQ: XString.MapCharProc = [ 
xset: CO. .256) <- XChar.Setfc]; 
xcode: [0..256) <- XChar.Code[c]; 
mapc: CARDINAL; 
putc: PutCProc = va.putc; 
zStrlng: LONG STRING «■ ”0000"L; 
tString; LONG STRING <- [5]; 


IF tct[xset] # NIL THEN { 
mapc *■ tcfc[xset][xcode]; 

SELECT mapc FROM 

IN [10000..19999] => { 

String,AppendDecimal[tString, mapc - 
zString , length <- 4 - tString . length; 
Puts[va, zStrlng]; 

tString]; 

Ascii.SP]; 


10000 ]; 


12B 


Puts[va, 
putc[va 
}i 

, 15B => 

Puts[va, 

IF va.n > 0 THEN FlushLine[va]; 


c 

va.dst.text[endLine]]; 


'©.s: 1 VflL[mapc]]; 


): 


ENDCASE >> { 

Puts[va, va.dst.text[vtoaReplaceUnknown]]; 

}; 

} 

ELSE Puts[va, va.dst.text[vtoaReplaceUnknown]]; 

Stop <■ FALSE; 


--/* begin code */ 

IF CheckAbort[va.background] THEN ERROR ABORTED; 
[] *■ XString .Map[r: text, proc: XnToXO] ; 
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--/* put procs */ 

UnbufferedPutC: PutCProc * { 

Stream.PutChar[va.output, c]; 

}: 


BufferedPutC: PutCProc a { 

line: LONG STRING <- va.llne; 

output: NSFileStream.Handle <- va.output; 

IF va.pos > va.max THEN 

{ 

IF va.wordwrap THEN 

{ 

offset: CARDINAL; 

--/* determine offset to new text ♦/ 

IF va.lastWh1te = CARDINAL.LAST THEN 

{ 

IF va.n > 0 THEN 

( 

va.lastWhite «■ va.n - 1; 
offset *■ va.n; 

} 

ELSE 

offset «- va.lastWhlte «■ 0; 

} 

ELSE 

offset «■ va.lastWhite + 1; 

—/* flush to mark */ 

FOR i: CARDINAL IN [0..va.1astWhlte] DO 
Stream.PutChar[output, 11ne[ 1]] ; 

ENDLOOP; 

—/* end line */ 

RawPuts[va, va.dst.text[endLine]]; 

—/* restore line */ 

FOR 1: CARDINAL IN [offset..va.n) DO 
11ne[i-offset] «■ 11 ne[ 1 ]; 

ENDLOOP; 

va.n <- va.n - offset; 
va.lastWhlte CARDINAL . LAST; 

—/* reset pos */ 
va.pos «- 0; 

FOR 1: CARDINAL IN [0..va.n) DO 

va.pos *■ IF 11ne[1] = Ascii.TAB THEN 

((va.pos / tablnterval) + 1) * tablnterval 
ELSE IF (c = Ascii.CR OR c = Ascii.LF) THEN 
va.pos 

ELSE 

va.pos + 1; 

ENDLOOP; 

} 

ELSE 

c 

RawPuts[va, line, va.n]; 

—/♦ end line */ 

RawPuts[va, va.dst.text[endLine]]; 
va.n +- 0; 
va.pos «• 0 ; 

}: 


IF va.n >■ line.length THEN 

{ 

RawPuts[va, line]; 
va.n «■ va.pos «■ 0; 
va.lastWhite *- CARDINAL.LAST; 
}; 


—/* append character +/ 

11 ne[va. n] «- c; 

IF c ■ Ascii.SP THEN va.lastWhlte «■ va.n; 
va.pos <■ IF c 5 Ascii.TAB THEN 

((va.pos / tablnterval) + 1) * tablnterval 
ELSE IF (c = Ascii.CR OR c = Ascii.LF) THEN 
va.pos 

ELSE 

va.pos + 1; 

va.n *- va.n + 1; 


--/* put a string */ 

Puts: PROC [va: VAData, $: LONG STRING] = { 
IF s = NIL THEN RETURN; 

IF s.length = 0 THEN RETURN; 
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FOR i: CARDINAL IN [0..s.length) DO 
va.putc[va, s[1]] ; 

ENDLOOP; 


—/* raw put string */ 

Raw Puts: PROC [va: VAData, s: LONG STRING, limit: CARDINAL «- CARDINAL. LAST] = ( 
IF S * NIL THEN RETURN; 

IF s.length = 0 THEN RETURN; 

IF limit = CARDINAL.LAST THEN limit <- s.length; 

FOR 1: CARDINAL IN [0..limit) DO 

Stream.PutChar[va.output, s[i]]; 

ENDLOOP; 


FlushL.lne: PROC [va: VAData] = { 
RawPuts[va, va.line, va.n]; 
va.n <- va.pos «• 0; 
vei. lastWhite «■ CARDINAL . LAST ; 


--/* Table Procs */ 

InvertTCFile: PROC [tableName: XString.Reader, vat: LONG POINTER TO VPToAscI1SetMap] = { 
tf: NSFIle.Handle; 
ts: NSFileStream.Handle; 
xchar: XChar.Character; 

charMap: LONG POINTER TO VPToAscIICharMap; 
xset: [0. .256) *, 
tel code: CARDINAL; 

tf *■ GetTableFIle[tableName]; 

ts «• NSFileStream.Create[f11e: tf]; 

telcode <■ 0; 

DO 

ENABLE (Stream,EndOfStream => EXIT}; 
xchar «• LOOPHOLE[Stream,GetWord[ts]]; 

IF xchar # XChar.not THEN { 
xset «■ XChar. Set[xchar] ; 
charMap *■ vat[xset]; 

IF charMap = NIL THEN { 

vat[xset] *■ Space.ScratchMap[(charMapSize + Environment.wordsPerPage-1) / Envlronment .wordsPerPage] ; 
FOR c: CARDINAL IN [0..256) DO 
vat[xset][c] <- 0; 

ENDLOOP; 

charMap «■ vat[xset]; 

}: 

charMap[XChar.Code[xchar]] *■ telcode 10000; 

}: 

telcode «■ telcode + 1; 

ENDLOOP; 

Stream.Delete[ts]; 
ts + [NIL]; 


GetTableFlle: PROC [tableName: XString.Reader] RETURNS [file: NSFIle.Handle] = { 

-- assume folder is In System catalog 

folderName: XString. ReaderSody <- XString. FromSTRING["Transl iteration Tables"L]; 

ref: NSFile .Reference *■ TRASH; 

ref «- GetFile[@folderName, tableName]; 

file «- NSFile.OpenByReference[ref]; 


GetFile: PROC [folderName, flleName: XString.Reader] 

RETURNS [file: NSFi 1 e .Reference <- NSFile.nulIReference] = { 
directory: NSFile.Handle *• TRASH; 

FileFromName: PROC [name: XString.Reader] = { 

nsName: NSString .String «■ XString .NSStringFromReader[ 
r: name, z: BWSZone.1ogonSession]; 
handle: NSFile. Handle «■ NSF lie . nul lHandle ; 
filters: ARRAY [0..2) OF NSFile.Filter <- [ 
[matches[[name[nsName]]]]. 

[equal[[type[NSAss1gnedTypes.tUnspecified]]]]]; 

handle <- NSFile.F1nd[ 
directory: directory, 

scope: [filter: [and[DESCRIPTOR [filters]]]] 

! NSFile.Error => (handle «■ NSFi 1 e . null Handle; CONTINUE}]; 

IF handle # NSFile.nul1 Handle THEN ( 
file <- NSFi le .GetReference[handle]; 

NSFile.Close[handle]}; 

NSString.FreeString[z: BWSZone.logonSession, s: nsName]: 

}: 

directory «- Catalog .GetFi 1 e[name: folderName, readonly: TRUE]; 
FileFromName[flleName]; 

NSFile.Close[directory]; 
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Zzlnlt: PROC = { 

g z: UNCOUNTED ZONE = BWSZone.Permanent[]; 
flleName: XString.ReaderBody; 

--/* these Spaces should not be unmapped while this application Is loaded */ 

9 * [ 

prc: Space.ScratchMap[(setMapSIze + Environment.wordsPerPage-1) / Envlronment.wordsPerPage], 
roc: Space.ScratchMap[(setMapSIze + Environment.wordsPerPage-1) / Envlronment.wordsPerPage], 

gz: gz]: 

FOR s: CARDINAL IN [0..2SB) DO 
g.prc[s] «■ NIL; 
g.roc[s] *■ NIL; 

ENOLOOP; 

g.prc[0] *• Space. ScratchMap[(charMapSize + Envl ronment .wordsPerPage-1) / Envl ronment .wordsPerPage] ; 
g.prc[41B] * Space.ScratchMap[(charMapSIze + Envlronment.wordsPerPage-1) / Envlronment.wordsPerPage]; 
g . prc[357B] «■ Space. ScratchMap[ (charMapSIze + Environment .wordsPerPage-1) / Envi ronment .wordsPerPage] 

g.roc[0] «- Space.ScratchMap[(charMapS1ze + Envlronment.wordsPerPage-1) / Envlronment.wordsPerPage]; 
g.roc[41B] <■ Space . ScratchMap[ (charMapSIze + Environment. wordsPerPage-1) / Envl ronment .wordsPerPage] ; 
g.roc[357B] «• Space .ScratchMap[ (charMapSIze + Envlronment.wordsPerPage-1) / Envi ronment .wordsPerPage] 

FOR c: CARDINAL IN [0..256) DO 
g.prc[0][c] «- c; 
g . prc[41B][c] «- 0; 
g.prc[357B][c] <- 0; 
g.roc[0][c] *■ c; 
g . roc[41B][c] «- 0 ; 
g.roc[357B][c] +■ 0; 

ENDLOOP; 

g.prc[0][2118] *• 1 IB ; 
g.prc[0][2448] - 44B ; 
g.prc[0][252B] <- 42B; 
g.prc[0][272B] «- 42B; 
g.prc[0][2518] <- 47B; 
g.prc[0][271B] «• 47B; 
g.prc[41B][76B] «- 55B; 
g.prc[357B][42B] 55B; 

g.prc[357B][41B] * 40B; 

g. roc[0][211B] «- 11B; 
g . roc[0][244B] «■ 44B; 
g.roc[0][252B] * 42B; 
g . roc[0][272B] <* 42B; 
g.roc[0][251B] <- 47B; 
g . roc[0][271B] <- 47B; 
g . roc[41B][76B] <- 55B; 
g . roc[357B][42B] <■ 55B; 
g. roc[357B][41B] <- 40B; 

fileName <- XString . FromSTRING["PRC .tcTable"L] ; 

InvertTCFile[8flleName, g.prc]; 

flleName «■ XString . FromSTRING["ROC .tcTable"L] ; 

InvertTCFile[8fileName, g.roc]; 


-- 21IB -> tab 
-- dollar -> $ 

— leftDoubleQuote -> " 

-- rightDoubleQuote -> " 

-- leftSIngleQuote -> * 

— rightSingleQuote -> ' 

-- hyphen -> minus 

-- nonBreakingHyphen -> minus 
-- nonBreakingSpace -> space 

-- 211B -> tab 
-- dollar -> $ 

— leftDoubleQuote -> " 

— rightDoubleQuote -> " 

-- leftSingleQuote -> * 

-- rightSingleQuote -> ' 

-- hyphen -> minus 

-- nonBreakingHyphen -> minus 
-- nonBreakingSpace -> space 


--/* main line code +/ 
Zzln1t[]; 


LOG 

16-Mar-87 
20-Jun -87 

10-Jul -87 
19-Aug -87 

16-Sep -87 


14:06:16 - Caro - Created 

11:30:20 - Caro - Added error catcher In ConvertProc over CreateCommon. 

IS08 now has correct ENOCASE 
11:31:10 - Caro - Added before/after line spacing 
11:03:02 - Caro - Fixed AR 13535 by updating oldtnstance window 
Fixed AR 13705 by flushing remaining text 
12:21:09 - Caro - Fixed AR 14393 by terminating with endPara 
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File: CvSTCFWImpl .mesa 

— Trow ll-Sep-89 12:36:36 

— Last Revised by: Erickson 17-Dec-87 16:03:15 

— Owner: Workstation Applications - Foreign Conversion Team 

-- Copyright (c) 1987, 1989 by Xerox Corporation. All rights reserved. 

DIRECTORY 
Attention 
USING [Post], 

Converter 

USING [MenuItemProc, ResIzeDetalIWIndow], 

CvSTC, 

FormWindow 

USING [Appendltem, AppendLlne. CholceChangeProc, Cholceltems, Create, 
GetBooleanltemValue, GetCholceltemValue, 

GetlntegerltemValue, GetTextltemValue, 

HasBeenChanged, HasAnyBeenChanged, LayoutProc, Line, MakeltemsProc, 
MakeBooleanltem, MakeCholceltem, Makelntegerltem, MakeTextltem, 

MinDImsChangeProc, 

SetBooleanltemValue, SetCholceltemValue, SetlntegerltemValue, 
SetTabStops, SetTextltemValue, 

SetViSibility, TabStops, SetSelectlon, SetlnputFocus] , 
FormWlndowMessageParse 

USING [FreeChoiceltems, ParseCholceltemMessage], 

NSFIle 

USING [Error], 

W indow 

USING [Handle], 

XStrlng 

USING [FreeReaderBytes, FreeWriterBytes, NewWriterBody, nullReaderBody, 
ReaderBody, WriterBody, InvalIdNumber, Overflow]; 


« 


OVERVIEW: 

Formwindow procedures 


» 


CvSTCFWImpl: PROGRAM 
IMPORTS 

Attention, Converter, CvSTC, 

Formwindow, FormWindowMessageParse, NSFIle, XStrlng 
EXPORTS 
CvSTC => 

BEGIN 


CONSTANTS 


textWidth: CARDINAL = 320; 

tabStopInterval: CARDINAL = CvSTC.pointsBetweenItems/2 ; 


-- PUBLIC PROCEDURES 


CommonMenu: PUBLIC Converter.MenuItemProc = { 

<< = PROCEDURE [Instance: LONG POINTER, menultem: PropertySheet. MenuItemType] RETURNS [ok; BOOLEAN <- TRUE];» 
my: CvSTC.Common = Instance: 

avPara: XStrlng.ReaderBody «- CvSTC.GetMessage[df 1 tAVEndParagraph] ; 
avChar; XStrlng.ReaderBody <- CvSTC .GetMessage[df 1 tAVReplaceCharacter] . 
valine: XStrlng .ReaderBody *- CvSTC .GetMessage[df 1 tVAEndLIne] ; 
vaPara: XStrlng.ReaderBody +■ CvSTC .GetMessage[dfl tVAEndParagraph]; 
vaChar: XStrlng .ReaderBody *■ CvSTC .GetMessage[dfl tVAReplaceCharacter] ; 

IF my = NIL THEN RETURN[ok: TRUE]; 

SELECT menultem FROM 
defaults => 

f 

SELECT my.owner FROM 
AtoVsrc => 

{ 

FormWindow.SetTextItemValue[ 
window: my.window, 

item: CvSTC.MessageKey.paraEndsWith.ORD, 
newValue: OavPara, 
repaint: FALSE]; 

FormWindow.SetChoiceltemValue[ 
window: my.window, 

item: CvSTC.MessageKey.codeScheme.ORD, 
newValue: CvSTC.dfltCodeScheme, 
repaint: FALSE]; 

}: 

AtoVdst => 

{ 

FormWindow.SetChoiceItemValue[ 
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window: my.window, 

Item: CvSTC.MessageKey.font.ORD, 
newValue: CvSTC.df1tFont, 
repaint: FALSE]; 

FormWindow.SetCholceltemValue[ 
window: my.window, 

item: CvSTC.MessageKey. fontsize.ORD, 
newValue: CvSTC.dfltFontSize, 
repaint: FALSE]; 

FormWIndow.SetTextltemValue[ 
window: my.window, 

Item: CvSTC.MessageKey.rep 1aceUnknown.ORD, 
newValue: OavChar, 
repaint: FALSE]; 

FormWindow.SetBooleanltemValue[ 
window: my.window, 

Item: CvSTC.MessageKey,IgnoreTrailing.ORD, 
newValue: CvSTC.dfltTrai1Ing, 
repaint: FALSE]; 

FormWIndow.SetBooleanltemValue[ 
window: my.window, 

item: CvSTC.MessageKey.includeTelCodes.ORD, 
newValue: CvSTC.dfltTelCodes, 
repaint: TRUE]; 

}; 

VtoAdst => 

{ 

FormWindow.SetChoiceltemValue[ 
window: my.window, 

item: CvSTC.MessageKey.codeScheme.ORD, 
newValue: CvSTC.dfltCodeScheme, 
repaint: FALSE]; 

FormWindow.SetChoiceItemValue[ 
window: my,window, 
item: CvSTC.MessageKey.1IneLen.ORD, 
newValue: CvSTC.dfltLIneLen, 
repaint: FALSE]; 

FormWindow.SetintegerltemVal ue[ 
window: my.window, 

Item: CvSTC.MessageKey.charsSufflx.ORD, 
newValue: CvSTC,dfltChars, 
repaint: FALSE]; 

FormWindow.SetBooleanltemValue[ 
window; my.window, 
item: CvSTC.MessageKey.wordwrap.ORD, 
newValue: CvSTC.dfltWordWrap, 
repaint: FALSE]: 

FormWindow.SetTextltemValue[ 
window: my.window, 

Item: CvSTC.MessageKey,endLlne.ORD, 
newValue: QvaLlne, 
repaint: FALSE]; 

FormWindow.SetTextItemValue[ 
window; my.window, 

Item; CvSTC.MessageKey.endPara.ORD, 
newValue: @vaPara, 
repaint: FALSE]; 

FormWindow.SetTextltemValue[ 
window: my.window, 

item: CvSTC.MessageKey.replaceUnknown.ORD, 
newValue: @vaCbar, 
repaint: TRUE]; 

}; 

ENOCASE; 

}: 

done => 

{ 

ENABLE NSFile.Error, CvSTC.Problem => 

{ 

msgRb: XString.ReaderBody «■ CvSTC.GetMessage[donefailed]; 
Attention.Post[@msgRb]; 

GOTO notOK; 

}: 

IF FormWindow.Ha$AnyBeenChanged[my.window] THEN 

{ 

ok <- ApplyCbanges[my]; 

IF NOT Ok THEN GOTO notOK; 

CvSTC.StoreF11edData[my]; 

EXITS notOK => RETURN[ok: FALSE]; 

}: 

start => 

c 

ok * ApplyChanges[my]; 

}: 

ENDCASE; 

}S 


CreateFW: PUBLIC PROC [my; CvSTC.Common, window: Window,Handle, owner: CvSTC.Owners] = { 
SELECT owner FROM 
AtoVsrc => 

c 

FormWindow.Create[ 
window: window, 
makeltemsProc: MakeAtoVSrc, 
layoutProc: LayoutAtoVSrc, 
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minDImsChangeProc: GrowParent, 
cllentOata: my]; 

CvSTC.DataToW1ndow[my, window]; 

}: 

AtoVdst => 

c 

FormWlndow.Create[ 
window: window, 
makeltemsProc: MakeAtoVDst, 

1ayoutProc: LayoutAtoVDst, 
clIentData; my]; 

}: 

VtoAdst => 

c 

FormWindow.Create[ 
window: window, 
makeltemsProc: MakeVtoADst. 

1ayoutProc: LayoutVtoADst, 
mlnDimsChangeProc: GrowParent, 
clIentData: my]; 

CvSTC.DataToWindow[my, window]; 

}; 

backstop => 

{ 

FormWlndow.Create[ 
window: window, 
makeltemsProc: MakeBackstop]; 

}*. 

ENDCASE; 


— PROCEDURES 


ApplyChanges: PROC [my: CvSTC .Common] RETURNS [ok: BOOLEAN «- TRUE] = { 

bufWb: XString .Wr IterBody <■ XString .NewWriterBody[maxLength: 30, z: my.z]; 

SELECT my.owner FROM 
AtoVsrc => 

c 

IF FormWlndow.HasBeenChanged[window: my.window. Item: CvSTC.MessageKey.paraEndsWith.ORD] THEN 

{ 

IF my,textRb[paraEndsW1th] # XString.nulIReaderBody THEN 

XString.FreeReaderBytes[@my.textRb[paraEndsWith], my.z]; 
my.textRb[paraEndsWith] «■ FormWindow,GetTextItemValue[ 
window: my.window, 

1 tern: CvSTC.MessageKey.paraEndsWith.ORD, 
zone: my.z]; 

}i 

[ok: ok, Is: my.text[paraEnd$W1 th]] *■ CvSTC.Parseltem[ 
my: my, 

r: @my.textRb[paraEndsWith], 

Item: CvSTC.MessageKey.paraEndsWith, 
buf: QbufWb]; 

IF NOT Ok THEN RETURN; 


IF FormW1ndow.HasBeenChanged[window: my.window, Item: CvSTC.MessageKey.codeScheme.ORD] THEN 

{ 

my. f .avCodeScheme «- FormWindow,GetCho1ceItemVa1ue[ 
window: my.window, 

item: CvSTC.MessageKey.codeScheme.0R0]; 

}: 

}: 

AtoVdst => 


c 

IF 


IF 


IF 


FormWlndow,HasBeenChanged[my.wlndow, CvSTC.MessageKey.font.ORD] THEN 

{ 

my.f.font +■ FormW1ndow.GetChoiceItemValue[ 
window: my.window, 
item; CvSTC.MessageKey.font.ORD]; 


FormWlndow.HasBeenChangedfmy.window, 

{ 


CvSTC.MessageKey.fontSIze.ORD] THEN 


my.f.fontSlze <- FormWindow.GetChoiceItemValue[ 
window: my.window, 

item: CvSTC.MessageKey.fontSize.ORD]; 


FormWlndow.HasBeenChanged[my.window, CvSTC.MessageKey.replaceUnknown.ORD] THEN 

c 

IF my,textRb[atovReplaceUnknown] # XString.nullReaderBody THEN 

XString.FreeReaderBytes[@my.textRb[atovReplaceUnknown], my.z]; 
my . textRb[atovReplaceUnknown] «- FormWindow.GetTextItemValue[ 
window: my.window, 

item: CvSTC.MessageKey.replaceUnknown.ORD, 
zone; my.z]; 


[ok: ok, Is: my. text[atovReplaceUnknown]] «- CvSTC. Parseltem[ 
my: my, 

r: Qmy,textRb[atovReplaceUnknown], 
item: CvSTC.MessageKey.replaceUnknown, 
buf: @bufWb]; 

IF NOT ok THEN RETURN; 


IF FormWindow.HasBeenChanged[my.window, CvSTC.MessageKey.ignoreTralling,ORD] THEN 

my. f . ignoreTrail Ing .value «- FormWindow .GetBooleanItemValue[ 
window: my.window, 


CvSTCFWImpl.mesa 


ll-Sep-89 12:36:37 PDT 


3 





Item: CvSTC.MessageKey,IgnoreTrallIng.ORD]; 


}: 


IF FormWindow.HasBeenChanged[my.window, CvSTC.MessageKey.includeTelCodes.ORD] THEN 

my.f. includeTelCodes.value «■ FormW1ndow.GetBooleanItemValue[ 
window: my.window, 

Item: CvSTC.MessageKey.IncludeTelCodes.ORD]: 

}: 

}; 

VtoAdst => 


{ 

IF FormWindow.HasBeenChanged[my.window, CvSTC.MessageKey.codeScheme.ORD] THEN 

c 

my.f. vaCodeScheme <• FormW1ndow.GetChoiceItemValue[ 
window: my.window, 

item: CvSTC.MessageKey.codeScheme.ORD]; 

}: 

IF FormWIndow.HasBeenChanged[my.window, CvSTC.MessageKey.1ineLen.ORD] THEN 

{ 

my.f.llneLen +• FormWIndow.GetChoiceltemValue[ 
window: my.window. 

Item: CvSTC.MessageKey.1ineLen.ORD]; 

}; 

IF FormWIndow.HasBeenChanged[my.window, CvSTC.MessageKey.charsSuffix.ORD] THEN 

{ 

my.f.charsSuffix «■ CARDINAL[FormWindow.GetIntegerItemValue[window: my.window, 
Item: CvSTC.MessageKey.charsSuffix.ORD ! 

XStrlng.InvalidNumber => { 

msgRb; XStrlng.ReaderBody + CvSTC.GetMessage[extraErrl]; 

Attention.Po$t[@msgRb]; 

GOTO Badnum; 

}i 

XStrlng.Overflow => { 
my.f.charsSufflx «• 0 ; 

CONTINUE: 

}]]i 

IF my.f.charsSuffix NOT IN [10..256] THEN 

( 

msgRb: XStrlng .ReaderBody CvSTC ,GetMessage[chars0ut0f8ounds] ; 

Attention.Post[@msgRb]; 

GOTO Badnum; 


}; 

EXITS 

Badnum => { 

FormWindow.SetSelection[w1ndow: my.window, 

1 tern: CvSTC.MessageKey.charsSuffix.ORD, 
flrstChar: 0, lastChar: CARDINAL.LAST]; 
formWindow.SetInputFocus[window: my.window, 

Item: CvSTC.MessageKey.charsSuffix.ORD, 
beforeChar: CARDINAL.LAST]; 

RETURN[ok: FALSE]; 

}; 

}i 

IF FormWindow.HasBeenChanged[my.window, CvSTC.MessageKey.wordwrap.ORD] THEN 

t 

my .f .wordwrap . value <- FormWindow.GetBooleanltemValue[ 
window: my.window, 

item: CvSTC.MessageKey.wordwrap.ORD]; 

): 

IF FormWindow.HasBeenChanged[my.window, CvSTC.MessageKey.endLine.ORD] THEN 
{ 

IF my.textRb[endLine] # XStrlng.nulIReaderBody THEN 

XString.FreeReaderBytes[@my.textRb[endLine], my .z] ; 
my. textRb[endLlne] <■ FormWi ndow. GetTextltemVal ue[ 
window: my.window, 

Item: CvSTC.MessageKey.endLine.ORD, 
zone: my.z]; 

}; 

[ok: ok. Is: my.text[endLlne]] <- CvSTC.Parseltem[ 
my: my, 

r: @my.textRb[endL1ne], 
item: CvSTC.MessageKey.endLine, 
buf: SbufWb]; 

IF NOT ok THEN RETURN; 


IF FormWindow.HasBeenChanged[my.window, CvSTC.MessageKey.endPara.ORD] THEN 

{ 

IF my.textRb[endPara] # XStrlng.nullReaderBody THEN 

XString.FreeReaderBytes[@my.textRb[endPara], my.z]; 
my. textRb[endPara] «- FormWi ndow .GetTextItemValue[ 
window: my.window, 

Item: CvSTC.MessageKey.endPara.ORD, 
zone: my.z]; 

}: 

[ok; ok. Is: my.text[endPara]] «■ CvSTC.Parseltem[ 
my: my, 

r: @my.textRb[endPara], 

Item: CvSTC.MessageKey.endPara, 
buf: QbufWb]; 

IF NOT ok THEN RETURN; 

IF FormWindow.HasBeenChanged[my.window, CvSTC.MessageKey.replaceUnknown.ORD] THEN 

{ 

IF my.textRb[vtoaReplaceUnknown] # XString.nullReaderBody THEN 

XString.FreeReaderBytes[@my.textRb[vtoaReplaceUnknown], my.z]; 
my. textRb[vtoaReplaceUnknown] *- FormWindow.GetTextItemValue[ 
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window: my.window, 

item: CvSTC.MessageKey.replacellnknown.ORD, 
zone: my.z]; 

}: 

[ok: ok. Is: my. text[vtoaRep1 aceUnknown]] <- CvSTC . Parseltem[ 
my: my, 

r: Qmy.textRb[vtoaReplaceUnknown], 

Item: CvSTC.MessageKey.replaceUnknown, 
buf: QbufWb]; 

IF NOT ok THEN RETURN; 

}; 

ENDCASE: 

XStrlng.FreeWriterByte$[@bufWb]; 


GrowParent: FormWindow.MInDImsChangeProc = { 

<< i! PROCEDURE [window: Window.Handle, old: Window.Dims, new: Window.Dims]; 

>> 

my: CvSTC.Common = CvSTC.DataFromWIndow[window]; 
oldHeight: INTEGER; 

--/* don’t adjust the first time window Is viewed */ 

IF my = NIL THEN RETURN; 

IF old = new THEN RETURN; 

—/* defaulting newHelght returns oldHeight without resizing */ 
oldHeight «■ Converter.ResIzeDetallWindow[ 
cvData: my.cvData, 
window: window, 

which: IF my.owner = AtoVsrc THEN source ELSE destination]; 

--/* now resize window */ 

[] *■ Converter.Res1zeDeta11W1ndow[ 
cvData: my.cvData, 
window: window, 

which: IF my.owner 3 AtoVsrc THEN source ELSE destination, 
newHelght: oldHeight (new.h - old.h)]; 

}: 


MakeBackstop: FormWIndow.MakeltemsProc 3 { 

tag: XStrlng . ReaderBody *• CvSTC .GetMessage[backstop] ; 

FormWindow.MakeTextItem[ 
window: window, 

myKey: CvSTC.MessageKey.backstop.ORD, 
boxed: FALSE, 
readonly: TRUE, 
width: 400, 

InltString: Hag]; 


MakeAtoVDst: FormWIndow.MakeltemsProc = { 

« = PROCEDURE [window: Window.Handle, clIentData: LONG POINTER]; 

» 

my; CvSTC.Common = clIentData; 
tag: XStrlng.ReaderBody; 
tmp: XString.ReaderBody; 

tag *■ CvSTC ,GetMessage[font]; 

tmp <- CvSTC.GetMessage[fontChoices]; 

BEGIN 

values: FormWindOw.Choiceltems «■ FormWindowMessageParse.ParseChoiceItemMessage[choiceItemMessage: Hmp, zone: my.z]; 
FormWIndow.MakeChoIceItem[ 
window: window, 

myKey: CvSTC.MessageKey.font.ORD, 
tag: Hag, 
values: values, 

InltChoice: my.f.font, 
fullyDisplayed: TRUE]; 

FormWindowMessageParse . FreeChoiceItems[cho1ceItenis : values, zone: my.z]; 

END; 

tag «■ CvSTC .GetMessage[fontSize] ; 

tmp *■ CvSTC.GetMessage[fontSizeChoices] ; 

BEGIN 

values: FormWindOw.Choiceltems *■ FormWindowMessageParse.ParseCho1ceItemMessage[choiceltemMessage: Hmp, zone: my.z]; 
FormWIndow.MakeChoiceItem[ 
window: window, 

myKey: CvSTC.MessageKey.fontSize.ORD, 
tag: Stag, 
values: values, 

InltChoice: my.f.fontSize, 
fullyDisplayed: TRUE]; 

FormWindowMessageParse.FreeChoiceItems[choiceItems: values, zone: my.z]; 

END; 

tag *■ CvSTC .GetMe$$age[replaceUnknown] ; 

FormWindow.MakeTextItem[ 
window: window, 

myKey: CvSTC.MessageKey.replaceUnknown.ORD, 
tag: (Hag, 
width: textWidth, 
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initStrlng: @my.textRb[atovReplaceUnknown]]; 

tag *• CvSTC.GetMessage[ignoreTrailIng]; 

FormWindow.MakeBooleanItem[ 
window: window, 

myKey: CvSTC.MessageKey.IgnoreTra11Ing.ORD, 
label: [strlng[tag]], 

initBoolean: my.f,ignoreTrail 1ng.value]: 

tag *- CvSTC.GetMessage[1ncludeTe1Codes] ; 

FormWindow.MakeBoolean Item[ 
window: window, 

myKey: CvSTC.MessageKey.1ncludeTelCodes.ORD. 
label: [string[tag]], 

InitBoolean: my,f.1ncludeTelCodes.value]; 


MakoAtoVSrc: FormWindow.MakeltemsProc = { 

« « PROCEDURE [window: Window.Handle, clientData: LONG POINTER]; 

» 

my: CvSTC.Common = clientData; 
tag: XString.ReaderBody; 
tmp: XString.ReaderBody; 

tag <- CvSTC .GetMessage[paraEndsW1th]; 

FormW1ndow.MakeTextItem[ 
window: window, 

myKey: CvSTC.MessageKey.paraEndsWIth.ORO, 
tag: (Hag, 
width: textWIdth, 

InitString: @my.textRb[paraEndsWIth]]; 

tag CvSTC ,GetMessage[codeScheme] ; 
tmp 4- CvSTC.GetMessage[codeSchemeChoices]; 

BEGIN 

values: FormWindow.Choiceltems 4- FormWindowMessageParse.ParseChoiceItemMessage[choiceItemMessage: @tmp, zone: my.z]; 
FormWindow.MakeChoiceltem[ 
window: window, 

myKey: CvSTC.MessageKey.codeScheme.ORD, 
tag: (Hag, 
values: values, 

InltChoice: my.f.avCodeScheme, 
fullyDisplayed: TRUE]; 

FormWindowMessageParse.FreeCho1ceItems[cho1ceItems: values, zone: my.z]; 

END; 


MakeVtoADst: FormWindow.MakeltemsProc = { 

<< * PROCEDURE [window: W1ndow.Handle, clientData: LONG POINTER];>> 
my: CvSTC.Common = clientData; 
tag: XString.ReaderBody; 
tmp: XString.ReaderBody; 

tag 4- CvSTC .GetMessage[codeScheme] ; 

tmp 4- CvSTC .GetMessage[codeSchemeChoi ces] ; 

BEGIN 

values: FormWindow.Choiceltems *- FormWindowMessageParse.ParseChoiceItemMessage[choiceItemMessage: @tmp, zone: my.z]; 
FormWindow.MakeChoiceltem[ 
window: window, 

myKey: CvSTC.MessageKey.codeScheme.ORD, 
tag: Stag, 
values: values, 

InitCholce: my.f.vaCodeScheme, 
fullyDIsplayed: TRUE]; 

FormWindowMessageParse.FreeChoiceItems[choiceItems: values, zone: my.z]; 

END; 

tag 4- CvSTC ,GetMessage[l IneLen] ; 

tmp 4- CvSTC.GetMessage[l 1 neLenChoices] ; 

BEGIN 

values: FormWindow.Choiceltems FormWindowMessageParse.ParseChoiceltemMessagefchoiceltamMessage: @tmp, zone: my.z]; 
FormWindow.MakeChoiceltem[ 
window: window, 

myKey: CvSTC.MessageKey.1IneLen.ORD, 
tag: (Hag, 
values: values, 

InitCholce: my.f.1IneLen, 
changeProc: LineLenXProc, 
fullyDIsplayed: TRUE]; 

FormWindowMes$ageParse.FreeChoiceItems[choiceItems: values, zone: my.z]; 

END; 

tag 4- CvSTC.GetMessage[charsSuff lx] ; 

ForraWindow.MakeIntegerItero[ 
window: window, 

myKey: CvSTC.MessageKey.charsSuffix.ORD, 
suffix: Stag, 

visibility: IF my.f,11neLen = CvSTC.1imited THEN visible ELSE invisible, 
signed: FALSE, 
width: 30, 

initlnteger: INTEGER[my.f.charsSuffix]]; 

tag 4- CvSTC .GetMessage[wordWrap] ; 

FormW1ndow.MakeBooleanItem[ 
window: window, 
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myKey: CvSTC.MessageKey.wordwrap.ORD, 

visibility: IF my.f.llneLen = CvSTC.1Imlted THEN visible ELSE invisible, 
label: [str1ng[tag]], 

InltBoolean: my.f.wordwrap.value]; 

tag «• CvSTC.GetMessage[endL1 ne] : 

FormWindow.MakeTextItem[ 
window: window, 

myKey: CvSTC.MessageKey.endLIne.ORD, 
tag: @tag, 
width: textWidth, 

InltStrlng: @my.textRb[endLine]]; 

tag <■ CvSTC.GetMessage[endPara] ; 

FormWindow.MakeTextItem[ 
window: window, 

myKey: CvSTC.MessageKey.endPara.ORD, 
tag; @tag, 
width: textWIdth, 

InltStrlng: @my,textRb[endPara]]; 

tag *■ CvSTC.GetMessage[ replaceUnknown] ; 

FormWindow.MakeTextItem[ 
window: window, 

myKey: CvSTC.MessageKey.replaceUnknown.ORD, 
tag: Stag, 
width: textWidth, 

initStrlng: @my.textRb[vtoaReplaceUnknown]]; 


LayoutAtoVDst: FormWIndow.LayoutProc = { 

« == PROCEDURE [window: Window .Handle, clIentData: LONG POINTER]; 

» 

leadingMargin: CARDINAL = CvSTC.leadlngMargln; 
spaceAboveLlne: CARDINAL = 5; 
line: FormWindow.Line; 

tabCholce: fixed FormWIndow.TabStops a [f1xed[tabStopInterval]] ; 

FormWIndow.SetTabStops[window, tabCholce]; 

line *■ FormWindow.AppendL1ne[window, spaceAboveLlne]; 

FormWindow.Appendltem[ 
window: window, 

item: CvSTC.MessageKey.font.ORD, 
line: line, 

preMargln: CvSTC.GetPreMargin[font] MOD tabStopInterval, 
tabStop: CvSTC.GetPreMargin[font] / tabStopInterval, 
repaint: FALSE]; 

line *■ FormWindow.AppendLine[w1ndow, spaceAboveLlne]; 

Fo rmW1ndow.AppendItem[ 
window: window, 

Item : CvSTC.MessageKey.fontSize.ORD, 
line: line, 

preMargln: CvSTC.GetPreMargin[fontSize] MOD tabStopInterval, 
tabStop: CvSTC.GetPreMargin[fontSize] / tabStopInterval, 
repaint: FALSE]: 

line <- FormWindow. AppendLi ne[w1ndow , spaceAboveLine] ; 

FormWindow.Appendltem[ 
window; window, 

Item: CvSTC.MessageKey.replaceUnknown.ORD, 
line; line, 

preMargln: CvSTC.GetPreMarglnfreplaceUnknown] MOD tabStopInterval, 
tabStop: CvSTC.GetPreMarg in[replaceUnknown] / tabStopInterval, 
repaint: FALSE]; 

line *■ FormWindow.AppendL1ne[window, spaceAboveLine]; 

FormWindow.AppendItem[ 
window: window. 

Item: CvSTC.MessageKey.IgnoreTrailing.ORD, 
line: line, 

preMargln: CvSTC.GetPreMarg1n[1gnoreTra11ing] MOD tabStopInterval, 
tabStop: CvSTC,GetPreMargin[1gnoreTrailIng] / tabStopInterval, 
repaint: FALSE]; 

line *• FormWindow.AppendL1ne[w1 ndow, spaceAboveLine]; 

FormWindow.AppendItem[ 
window: window, 

Item: CvSTC.MessageKey.includeTelCodes.ORD, 
line: line, 

preMargln: CvSTC,GetPreMarg1n[includeTelCodes] MOD tabStopInterval, 
tabStop: CvSTC.GetPreMargin[includeTelCodes] / tabStopInterval, 
repaint: FALSE]; 


LayoutAtoVSrc: FormWindow.LayoutProc = { 

<< = PROCEDURE [window: W1ndow.Hand!e, clIentData: LONG POINTER]; 

» 

1eadingMargin: CARDINAL = CvSTC.leadingMargin; 
spaceAboveLlne: CARDINAL - 5; 
line: FormWindow.Line; 

tabChoice: fixed FormWindow.TabStops = [f1xed[tabStopInterval]]; 
FormW1ndow.SetTabStops[window, tabChoice]; 
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line <- FormWindow.AppendL1ne[window, spaceAboveLlne] ; 

FormWIndow.AppendItem[ 
window: window, 

item: CvSTC.MessageKey.paraEndsWith.ORD, 
line: line, 

preMargln: CvSTC.GetPreMarg1n[paraEndsW1th] MOD tabStopInterval, 
tabStop: CvSTC.GetPreMarg1n[paraEndsWith] / tabStopInterval, 
repaint: FALSE]: 

line «• FormWindow.AppendL1ne[w1ndow, spaceAboveLlne]: 

FormWindow.AppendItem[ 
window: window, 

item: CvSTC.MessageKey.codeScheme.ORD. 
line: line, 

preMargln: CvSTC.GetPreMargin[codeScheme] MOD tabStopInterval, 
tabStop: CvSTC.GetPreMarg1n[codeScheme] / tabStopInterval, 
repaint: FALSE]: 

line +• FormWindow.AppendL1ne[window, spaceAboveLlne]; 


LayoutVtoADst: FormWindow.LayoutProc * { 

« « PROCEDURE [window: W1ndow.Handle, clIentData: LONG POINTER];>> 
leadlngMargln: CARDINAL = CvSTC.1eadingMarg1n; 
spaceAboveLlne: CARDINAL = 5; 
line: FormWindow.Line: 

tabCholce: fixed FormWindow.TabStops = [f1xed[tabStopInterval]]: 

FormWindow.SetTabStops[w1ndow, tabCholce]; 

line «- FormWindow.AppendLine[w1ndow, spaceAboveLine] ; 

FormWindow.Append Item[ 
window: window, 

Item: CvSTC.MessageKey.codeScheme.ORD, 
line: line, 

preMargln: CvSTC.GetPreMargin[cadeScheme] MOD tabStopInterval, 
tabStop: CvSTC.GetPreMargin[codeScheme] / tabStopInterval, 
repaint: FALSE]; 

line «- FormWindow.AppendL1ne[w1ndow, spaceAboveLine]: 

FormWindow.Append Item[ 
window: window, 

Item: CvSTC.MessageKey.1IneLen.ORD, 
line: line, 

preMargln: CvSTC.GetPreMarg1n[lIneLen] MOD tabStopInterval, 
tabStop: CvSTC.GetPreMarg1n[lIneLen] / tabStopInterval, 
repaint: FALSE]; 

FormWindow.Append Itero[ 
window: window, 

item; CvSTC.MessageKey.charsSuffix.ORD, 
line: line, 

preMargln: CvSTC.GetPreMargin[charsSufflx], 
tabStop: , 
repaint: FALSE]; 

FormWindow.Appendltem[ 
window: window, 

Item: CvSTC.MessageKey.wordWrap.ORD, 
line: line, 

preMargln: CvSTC.GetPreMargin[wordWrap], 
tabStop: , 
repaint: FALSE]; 

line *■ FormW1ndow.AppendL1ne[w1ndow, spaceAboveLine]; 

FormWindow.AppendItem[ 
window: window, 

Item: CvSTC.MessageKey.endLlne.ORD, 
line: line, 

preMargln: CvSTC.GetPreMargin[endLine] MOO tabStopInterval, 
tabStop: CvSTC.GetPreMarg1n[endL1ne] / tabStopInterval, 
repaint: FALSE]; 

line «■ FormWi ndow. AppendLine[w1 ndow. spaceAboveLlne]; 

FormWindow.Appendltem[ 
window; window, 

item: CvSTC.MessageKey.endPara.ORD, 
line: line, 

preMargln: CvSTC.GetPreMargin[endPara] MOD tabStopInterval, 
tabStop: CvSTC,GetPreMargin[endPara] / tabStnplnterval, 
repaint: FALSE]; 

line <- FormWindow.AppendL1ne[window, spaceAboveLine]; 

FormWindow.Appendltem[ 
window: window, 

Item: CvSTC.MessageKey.replaceUnknown.ORD, 
line: line, 

preMargln: CvSTC.GetPreMargin[replaceUnknown] MOD tabStopInterval, 
tabStop: CvSTC.GetPreMargin[replaceUnknown] / tabStopInterval, 
repaint: FALSE]; 


--/* Change Procs */ 

LineLenXProc: FormWindow.ChoiceChangeProc = { 

<< 3 PROCEDURE [window; Window.Handle , item; FormWindow.ItemKey, cal 1edBecauseOf: FormWindow.ChangeReason, oldValue 
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FormWIndow.ChoiceIndex, newValue: FormWindow.Choicelndex]; 

» 

IF newValue * oldValue THEN RETURN; 

IF newValue = CvSTC.1Imlted THEN 

{ 

FormWIndow.SetVISibil1ty[ 
window: window, 

Item: CvSTC.MessageKey.charsSuffix.ORD, 
visibility: visible, 
repaint: FALSE]; 

FormWindow,SetVIsIbl11ty[ 
window: window, 

Item: CvSTC.MessageKey.wordwrap.ORD, 
visibility: visible, 
repaint: TRUE]; 

} 

ELSE 

{ 

FormWindow.SetVIsIbll1ty[ 
window: window. 

Item: CvSTC.MessageKey.charsSuffix.ORD, 
visibility: Invisible, 
repaint: FALSE]; 

FormWindow.SetVIsIbl11ty[ 
window: window, 

Item: CvSTC.MessageKey.wordwrap.ORD, 
visibility: Invisible, 
repaint: TRUE]; 

}; 

}: 


END,.. 

LOG 

16-Mar-87 14:06:16 - Caro - Created 

24-Mov-87 16:58:56 - Erickson - Changed paraEndsWIth default to <CR> instead of <CRXLF> 

17~Dec~87 15:48:52 - Erickson - AR 16414 - Added to ApplyChanges In the CvSTC.MessageKey.charsSuffix section. The value read from the 

prop sheet was expected to be a valid number. If text was entered, the converter crashed the system. I added signal checking for 

InvalIdNumber and Overflow. If text is entered, the InvalidNumber signal is raised by FormWindow.GetlntegerltemValue, and Is caught 
hero. The user’s input is then highlighted, that field of the propsheet Is made the Input focus, and a message Is posted indicating the 
problem. This message was placed In the extraErrl position In CvSTC 

MsgF11eImpl.mesa. While I was here, I added a catch phrase for the Overflow signal also, this simply sets the input value to zero and 

allows the already existing code to treat this as input out of range. 
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-- File: CvSTCMainlmpI.mesa 

— Trow 10-Sep-89 19:53:16 

-- Last Revised by: Caro 3G-3un~87 12:39:53 

-- Owner: Workstation Applications - Foreign Conversion Team 

-- Copyright (c) 1987, 1989 by Xerox Corporation. All rights reserved. 

DIRECTORY 

Atom 

USING [MakeAtom], 

Attention 

USING [Post], 

BWSZone 

USING [Permanent], 

Context 

USING [Create, Error, Find, NopDestroyProc, Type, UniqueType], 

Converter 

USING [DestlnatlonOptions, GetEventType, Register, Status, SourceOptlons], 
ConverterMsg 

USING [Get, kvpDocument], 

ConverterPFOptions 

USING [conASCII], 

CvSTC 

USING [AsciiToVP, Asc1IToVPDstOps, Asc1IToVPSrcOps, Common, 

GetMessage, leadlngMargln, MessageKey, 

poIntsBetweenltems, ProblemType, VPToAscll, VPToAsciIDstOps], 

Event 

USING [AddDependency, AgentProcedure, EventType], 

Process 

USING [Detach, Pause, SecondsToTIcks], 

ProductFactoring 

USING [Enabled], 

SlmpleTextDIsplay 

USING [MeasureString], 

StarFIleTypes 

USING [document, text, unspecified], 

Window 

USING [Handle], 

XStrlng 

USING [ReaderBody]; 


— OVERVIEW: 

Main code for ascii conversion. Reglstations done here. 


» 

CvSTCMainlmpI: PROGRAM 
IMPORTS 

Atom, Attention, BWSZone, Context, Converter, ConverterMsg, 
CvSTC, Event, Process, ProductFactoring, SlmpleTextDIsplay 
EXPORTS 
CvSTC = 

BEGIN 


— CONSTANTS 


— TYPES 


Globals: TYPE = RECORD [ 
leads: ItemLeads, 
ctype: Context.Type, 
z: UNCOUNTED ZONE]; 

ItemLeads: TYPE = ARRAY CvSTC,MessageKey[paraEndsW1th..1astPsheetltem] OF CARDINAL; 


— GLOBALS 


g: Globals; 


-- PUBLIC SIGNALS 


Problem: PUBLIC SIGNAL [err: CvSTC.ProblemType] = CODE; 


-- PUBLIC PROCEDURES 


DataFromWindow: PUBLIC PROC [w: Window.Hand!e] RETURNS [my: CvSTC.Common] = { 

my *r Context.Find[type: g.ctype, window: w ! Context.Error => (my *■ NIL; CONTINUE}]; 

}; 


DataToWindow: PUBLIC PROC [my: CvSTC.Common, w; Window.Handle] = { 
Context,Create[ 
type: g.ctype, 
data: my, 


CvSTCMainlmpI.mesa 


10-Sep-89 19:53:18 POT 


1 


















proc: Context.NopDestroyProc, 
window: w f Context.Error => CONTINUE]; 


GetPreMargln: PUBLIC PROC [Item: CvSTC.MessageKey] RETURNS [leads; CARDINAL] = { 
RETURN[g.leads[1tem]]; 

}; 


PROCEDURES 


I nit: PROC = { 

z: UNCOUNTED ZONE = BWSZone.Permanent[]; 
9 «■ [ 

leads: ALL[CARDINAL.LAST], 
ctype: Context.Un1queType[], 
z ■ *]: 

MeasureTags[]; 

--/* register with converter icon */ 
Reg1ster[]; 


MeasureTags: PROC a { 

lmarg; CARDINAL = CvSTC.leadlngMargin; 
max: CARDINAL «- 0; 

--/* local proc */ 

Length: PROC [key: CvSTC.MessageKey] RETURNS [width: CARDINAL] = 

{ 

rb: XStrlng .ReaderBody «■ CvSTC.GetMessage[key] ; 

[width: width] *■ SimpleTextDIsplay .MeasureString[string : @rb] ; 
RETURN [width]; 

}; 


--/* begin code */ 

g.leads *■ [ 

paraEndsWTth: Length[paraEndsWith], 

codeScheme: Length[codeScheme], 

codeSchemeCholces: 0, 

font: Length[font], 

fontChoices: 0, 

fontSIze: Length[fontS1ze], 

fontSizeChoices; 0, 

IgnoreTralling: 1, — no tag 

IncludeTelCodes: 1, -- no tag 

lineLen: Length[lineLen], 

1ineLenChoices: 0, 
charsSufflx: CARDINAL.LAST, 
wordwrap: CARDINAL.LAST. 
endtlne: Length[endLine], 
endPara: Length[endPara], 
replaceUnknown: Length[replaceUnknown], 

1astPsheetltem: 0]; 

--/* now determine max V 

FOR 1: CvSTC.MessageKey IN CvSTC.MessageKey[paraEnd$With..lastPsheetltem] DO 
IF g . 1eads[1] = CARDINAL.LAST THEN LOOP; 
max <- MAX[max, g.1eads[1]]; 

ENOLOOP; 

—/* now adjust ♦/ 

max «- max + lmarg; 

FOR 1: CvSTC.MessageKey IN CvSTC.MessageKey[paraEndsW1th..lastPsheetltem] DO 
SELECT g.leadsfl] FROM 
0 => LOOP; 

1 => g.leads[1] «• max + 8; — compensate for no tag 

CARDINAL. LAST => g.leads[i] *■ CvSTC. poIntsBetweenltems ; 

ENDCASE -> g.leads[1] *■ max - g.1eads[1]; 

ENDLOOP; 


ReglsterNow: PROC [first: BOOLEAN] RETURNS [allOk: BOOLEAN *• TRUE] = { 
doc: XStrlng .ReaderBody <- ConverterMsg.Get[ConverterMsg.kvpDocument] ; 
ascliDoc: XStrlng .ReaderBody *■ CvSTC.GetMessage[asciIDoc] ; 
status: Converter.Status; 

--/ + local proc *f 

Check: PROC [status: Converter.Status] = 

{ 

SELECT status FROM 

registered, alreadyExisted, overridden => NULL; 
busy => 

{ 

IF first THEN 

{ 

et: Event.EventType <- Converter.GetEventType[] : 

—/* tell user registration will be done later */ 
--+$$$ not implemented 

[] «- Event.AddDependency[ 
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}: 


agent: RetryRegistration, 
myOata: NIL, 
event: etj; 

first «■ FALSE; --/* only add once! */ 

}: 

allOk <- FALSE: 


}; 

error => allOk «• FALSE; —+$$$ should post a message 
ENDCASE; 


--/* begin code ♦/ 
status «- Converter.Register[ 
srcType: StarFi1eTypes.text, 
srcFormat: ©ascilDoc, 
destFormat: ©doc, 
convertProc: CvSTC.AsciiToVP, 
slzeChange: 190, 
forkable: TRUE].status; 

Check[status]; 

status «• Converter .Reg1ster[ 

srcType: StarFileTypes.unspecified, 
SrcFormat: QasciiDoc, 
destFormat: ©doc, 
convertProc: CvSTC.AsciIToVP, 
sizeChange: 190, 
forkable: TRUE].status; 

Check[status]; 

ascilDoc <- CvSTC.GetMessage[asci IDoc] ; 
status «■ Converter.Reg1ster[ 

srcType: StarF11eTypes.document, 
srcFormat: ©doc, 
destFormat: ©ascilDoc, 
convertProc: CvSTC.VPToAsci1, 

SlzeChange: 63, 
forkable: TRUE].status; 

Check[status]; 

—/* register ops */ 

IF NOT allOk THEN RETURN; 

status «■ Converter.DestinationOptions[ 
srcFormat: ©doc, 
destFormat: ©ascilDoc, 
dependentOptions: CvSTC.VPToAsciIDstOps, 
override: TRUE].status; 

Check[status]; 

ascilDoc «- CvSTC.GetMessage[asc 11Doc]; 
status «■ Converter.SourceOptions[ 
srcFormat: ©ascilDoc, 
destFormat: ©doc, 

dependentOptions: CvSTC.AsciiToVPSrcOps, 
override: TRUE] . status ' r 

Check[status]; 

status «■ Converter.Dest1natlonOpt1ons[ 
srcFormat: ©asciiDoc, 
destFormat: ©doc, 

dependentOptions: CvSTC.AscilToVPDstOps, 
override: TRUE].status; 

Check[status]; 


}; 


RetryReglstration: Event.AgentProcedure = { 

IF Regl sterNow[f i rs t: FALSE].allOk THEN remove «- TRUE; 

}: 


RetryProductFactoring: Event.AgentProcedure = { 

IF NOT ProductFactor1ng.Enabled[option: ConverterPFOptlons.conASCII] THEN 

c 

msg: XString .ReaderBody «- CvSTC .GetMessage[notPF] ; 

Attention.Post[©msg]; 
remove FALSE; 

} 

ELSE 

c 

Process.Detach[FORK AvoidDeadlock[]]; 
remove «■ TRUE; 

}: 

}: 


« 
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AvoldDeadlock 

* Finish doing registrations In another process, to make sure we don’t try to AddDependency from Inside of an AgentProcedure. 


» 

Avo 1d[)eadlock: PROC = { 

Process.Pause[Process.SecondsToT1cks[2]]; —/* give other process a chance */ 
C'J «■ Reg1sterNow[fIrst: TRUE]; 

}: 


Register: PROCEDURE = { 

IF NOT ProductFactorlng.Enab1ed[option; ConverterPFOptIons.conASCII] THEN 

{ 

msg: XStrlng .ReaderBody <- CvSTC.GetMessage[notPF]; 

logon; Event .EventType *• Atom.MakeAtom["LogonComp1eted"L]; 

Attention.Post[@msg]; 

[] <- Event.AddDependency[ 

agent: RetryProductFactorlng, 
myDatar NIL, 
event; logon]; 

} 

ELSE [] <- ReglsterNow[first: TRUE]: — OK 

}S 

—/"■ MAIN code ♦/ 

Init[]; 


END , . . 

LOG 

ie-Mar-87 14:06:16 - Caro - Created 

30-dun-87 12:39:59 - Caro - MDS relief, RetryProductFactorlng 
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-- File: CvSTCMsgFilelmpl.mesa 
~ Trow 8-Mar-89 14:18:00 


— Last Revised by: Erickson 17-Dec-87 16:06:35 

— Owner: Workstation Applications - Foreign Conversion Team 

— Copyright (c) 1985, 1986. 1987, 1988, 1989 by Xerox Corporation. All rights reserved. 
DIRECTORY 

ApplIcationFolderExtra 
USING [InitMessages], 

CvSTC, 

NSFile 

USING [Error], 

Runtime 

USING [UnboundProcedure], 

XMessage 

USING [AllocateMessages, Gat, Handle, MsgEntry, Register-Messages], 

XStrlng 

USING [FromSTRING, nulIReaderBody, ReaderBody]; 

CvSTCMsgFilelmpl: PROGRAM 
IMPORTS 

ApplIcationFolderExtra, NSFile, Runtime, XMessage, XStrlng 
EXPORTS CvSTC = 

BEGIN 


— GLOBALS 


h: XMessage.Handle * NIL; 

-.-.= H = = = = as = 33 = = = = = = = = 

— SIGNALS 

NoMossageFile: ERROR = CODE*, 

— PUBLIC PROCEDURES 

GetMessage: PUBLIC PROCEDURE [msg: CvSTC.MessageKey] RETURNS [msgRb: XStrlng.ReaderBody] - { 
IF h # NIL THEN RETURN[h.Get[msg.ORD]]; 

RETURN[XStrlng.nullReaderBody]; 

}; 

-- PROCEDURES 


InHMessages: PROCEDURE = { 

InternalName: XStrlng .ReaderBody <- XStrlng.FromSTRING["FC STC Document$"L] ; 
messageFIle: XString .ReaderBody «- XString. FromSTRING["MessageFne"L]; 

h «• Appl IcationFolderExtra. InitMessages[ 

InternalName: ©Internal Name, 
label: QmessageFile, 

domainlndex: 0 ! ANY => (h *- NIL; CONTINUE}]; 

IF h = NIL THEN 

In1tFromArray[]; 

}: 


InltFromArray: PROC = { 

h «* XMessage,A1locateMessage$[”STC Conversion'^, CvSTC. MessageKey. LAST. ORD. SUCC , NIL, NIL]; 

In1t0tol7[]; 

Initl8toLAST[]; 


InitOtol7: PROC = £ 

msgArray: ARRAY CvSTC.MessageKey[asciiDoc..1astPsheetltern] OF XMessage .MsgEntry «- [ 
ascllDoc: [ 

msgKey: CvSTC.MessageKey.asciiDoc.ORD, 

msg: XStrlng.FromSTRING["Chinese Telegraph Code$"L], 

type: userMsg, 

translationNote: "Label for source or destination of conversion"L, 
translatable: FALSE, 
id: 0], 

paraEndsWith: £ 

msgKey: CvSTC.MessageKey.paraEndsWith.ORD, 
msg: XString.FromSTRING["Paragraph ends with"L], 
type: pSheetltem, 

translationNote: "Tag for text item, should read as if user were filling in the blank/completing the sentenced, 
translatable: TRUE, 
id: 1], 
codeScheme: [ 

msgKey: CvSTC.MessageKey.codeScheme.ORD, 

msg: XString.FromSTRING["Telegraph code scheme"L], 

type: pSheetltem, 

translationNote: "Choice item tag"L, 
translatable: TRUE, 

Id: 2], 

codeSchemeChoices: [ 
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msgKey: CvSTC.MessageKey.codeSchemeChoIces.ORD, 
msg: XStrlng.FromSTRING["PRC/stc:0@R0C/ctc:1"L], 
type: argList, 

translationNote: "Choices that go with 1d02"L, 
translatable: FALSE, 

Id: 3], 
font: [ 

msgKey: CvSTC.MessageKey.font.ORD, 
msg : XStrlng.FromSTRING["Font"L], 
type: pSbeetltem, 

translationNote: "Choice item tag"L. 
translatable: TRUE, 

Id: 4], 

fontChoices: [ 

msgKey: CvSTC.MessageKey.fontChoices.ORD, 

msg: XString,FromSTRING["Modern:0@C1assic: 1"L] , 

type: argList, 

translationNote: "Choices that go with 1d#4"L, 
translatable: TRUE, 

Id: 5], 
fontSize: [ 

msgKey: CvSTC.MessageKey.fontSize.ORD, 
msg: XStrlng.FromSTRING["Font size"l], 
type: pSheetltem, 

translationNote: "Choice Item tag"L, 
translatable: TRUE, 

Id: 6], 

fontSIzeCholces: [ 

msgKey: CvSTC.MessageKey.fontSIzeChoices.ORD, 
msg: XStrlng.FromSTRING["12:0@24:l'T], 
type: argList, 

translationNote: "Choices that go with 1d#6"L, 
translatable: TRUE, 

Id: 7], 

IgnoreTrallIng: [ 

msgKey: CvSTC.MessageKey.IgnoreTrailing.ORD, 

msg: XString.FromSTRlNG["IGNORE TRAILING WHITE SPACE"l], 

type: pSheetltem, 

translationNote: "Boolean item"L, 

translatable: TRUE, 

Id: 8], 

IncludeTelCodes: [ 

msgKey: CvSTC.MessageKey.IncludeTelCodes.ORO, 
msg: XStrlng.FromSTRING["INCLUDE TELEGRAPH C0DES"L], 
type: pSheetltem, 
translationNote: "Boolean ltem"L, 
translatable: TRUE, 

Id: 9], 
llneLen: [ 

msgKey: CvSTC.MessageKey.1IneLen.ORD, 
msg: XStr1ng.FromSTRING["L1ne length"L], 
type: pSheetltem, 

translationNote: "Choice Item tag"L, 
translatable: TRUE, 

Id: 10], 

1IneLenChoices: [ 

msgKey: CvSTC.MessageKey.1IneLenChoices.ORD, 
msg: XString.FromSTRING["Uniimlted:0@L1mited:1"L], 
type: argList, 

translationNote: "Choices that go with id#10"L, 
translatable: TRUE, 

Id: 11], 
charsSuffix: [ 

msgKey: CvSTC.MessageKey.charsSufflx.ORD, 
msg: XStrIng.FromSTRING["characters'^], 
type: pSheetltem, 

translationNote: "Suffix for number item — to be read e.g. '[80] characters *"L, 
translatable: TRUE, 
id: 12], 
wordwrap: [ 

msgKey: CvSTC.MessageKey.wordwrap.ORD, 
msg: XStrlng.FromSTRING["WORD WRAP"L], 
type: pSheetltem, 

translationNote: "Boolean item, Indicating that text lines should break only on the white space between words"L, 
translatable: TRUE, 

Id: 13], 
endLlne: [ 

msgKey: CvSTC.MessageKey.endLlne.ORD, 
msg: XString.FromSTRING["End line with"L], 
type: pSheetltem, 

translationNote: "Text Item tag, should read as if user Is filling in the blank/completing sentenced, 
translatable: TRUE, 
id: 14], 
endPara: [ 

msgKey: CvSTC.MessageKey.endPara.ORD, 

msg: XString.FromSTRING["End paragraph with"L], 

type: pSheetltem, 

translationNote: "Text item tag. should read as If user Is filling In the blank/completing sentence"L, 
translatable: TRUE, 

Id: 15], 

replaceUnknown: [ 

msgKey: CvSTC.MessageKey.replaceUnknown.ORD, 

msg: XString.FromSTRING["Replace unknown character w1tb"L], 

type: pSheetltem, 

translationNote: "Text Item tag, should read as if user is filling in the blank/completlng sentence"L, 
translatable: TRUE, 
id: 16], 
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lastPsheetltem: [ 

msgKey: CvSTC.MassageKey.lastPsheetltem.ORD, 
msg: XStrlng .FromSTRING[" "L], 
type: others, 

translationNote: "DO NOT TRANSLATE -- spare keyd, 
translatable: TRUE, 

Id: 17] 

]; 


XMessage.RegisterMessages[h, LOOPHOLE[LONG[DESCRrPTOR[msgArray]]], FALSE]; 


In1tl8toLAST; PROC = { 

msgArray: ARRAY CvSTC.MessageKey[left..CvSTC,MessageKey.LAST] OF XMessage.MsgEntry *■ [ 
left: [ 

msgKey: CvSTC.MessageKey.left.ORD, 
msg: XStrlng,FromSTRING["<d], 
type: others, 

translationNote: "do not translated, 
translatable: FALSE, 

Id: 18], 

right: [ 

msgKey: CvSTC.MessageKey.right.ORD, 
msg: XStrlng.FromSTRING[">”L], 
type: Others, 

translationNote: "do not translated, 
translatable: FALSE, 

Id: 19], 
cr: [ 

msgKey: CvSTC.MessageKey,cr.ORD, 
msg: XStrlng.FromSTRING["CR"L], 
type: others, 

translationNote: "do not translated, 
translatable: FALSE, 

Id: 20], 

If: [ 

msgKey: CvSTC.MessageKey.If.ORD, 
msg: XString.FromSTRING[ n LF"L], 
type: others, 

translationNote: "do not translated, 
translatable: FALSE, 
id: 21], 
nl: [ 

msgKey: CvSTC.MessageKey.nl.ORD, 
msg: XStrlng.FromSTRING["NL"L], 
type: others, 

translationNote: "do not translated, 
translatable: FALSE, 


1 ' • L 

msgKey: CvSTC.MessageKey.ff.ORD, 
msg: XStrlng.FromSTRING["FF"L], 
type: others, 

translationNote: "do not translated, 
translatable: FALSE, 
id: 23], 
tab: [ 

msgKey: CvSTC.MessageKey.tab.ORO, 
msg: XStrlng.FromSTRING["TA8"L], 
type: others, 

translationNote: "do not translated, 
translatable: FALSE, 
id: 24], 
createError: [ 

msgKey: CvSTC.MessageKey,createError.ORD, 

msg: XStrlng.FromSTRING["The source object was not converted due to an error while creating the output file.'d], 
type: errorMsg, 

translationNote: "Posted to attention windowd, 
translatable: TRUE, 

Id: 25], 
notPF: [ 

msgKey: CvSTC.MessageKey.notPF.ORD, 

msg: XStrlng.FromSTRING["Ch1nese Telegraph Code Conversion cannot be activated because required Software Option not enabled. 
Please enable Software Option, End Session, then Logon again.d], 
type: errorMsg, 

translationNote: "posted to attention windowd, 
translatable: TRUE, 
id: 26], 
paginating: [ 

msgKey: CvSTC.MessageKey.paginating.ORD, 
msg: XString.From$TRING[" paginating ... d], 
type: userMsg, 

translationNote: "posted to attention window following 'Converting xy z ... ' converter icon message. The leading and trailing 
spaces are REQUIRED'd, 
translatable: TRUE, 

Id; 27], 

skippedTableData: [ 

msgKey: CvSTC.MessageKey.skippedTableData.ORD, 

msg: XString.FromSTRING[" Some data in ’<>' was skipped ... ”L], 

type: template, 

translationNote: "Some table data skipped, Leading and trailing blanks REQUIRED.d, 
translatable: TRUE, 

Id: 28], 

df1tAVEndParagraph: [ 

msgKey: CvSTC.MessageKey.df1tAVEndParagraph.ORD, 
msg : XString . FromSTRING[ ,, <CRXCR>"L] , 
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type: others, 

translationNote: "do not translate, default value for text 1tems"L, 
translatable: FALSE, 

Id: 29], 

dfltAVReplaceCharacter: [ 

msgKey: CvSTC.MessageKey.dfltAVReplaceCharacter.ORD, 
msg: XString.FromSTRING["?"L] , 
type: others, 

translationNote: "do not translate, default value for text 1tems"L, 
translatable: FALSE, 
id: 30], 
prefix: [ 

msgKey: CvSTC.MessageKey.pref lx.ORD, 
msg: XStr i ng .FromSTRING[ ,, CvSTC ,, L] , 
type: others, 

translationNote: "do not translate, Internal file name pref1x"L, 
translatable: FALSE, 

Id: 31], 
doneFailed: [ 

msgKey: CvSTC.MessageKey.doneFailed.ORD, 

msg: XString.FromSTRING["Unrecoverable error writing Chinese Telegraph Code conversion properties. Cancel the property sheet and 
use a new converter icon."L], 
type: errorMsg, 

translationNote: "Posted when user selects Done on property sheet, if there is an NSFile or other error"L, 
translatable: TRUE, 

Id: 32], 
backstop: [ 

msgKey: CvSTC.MessageKey.backstop.ORD, 

msg: XString.FroraSTRING["Problem: the details section could not be created.”L], 
type: pSheetltem, 

translationNote: "For some reason, creation of the client details window failed. This string is put in the formwindow 
instead."L, 
translatable: TRUE, 

Id: 33], 
metaError: [ 

msgKey: CvSTC.MessageKey.metaError.ORD, 

msg: XString,FromSTRING["The selected text item contains an error. Please correct 1t."L], 
type: errorMsg, 

translationNote: "This message is posted to the Attention window when the user tries to Done or Start a sheet with a text/syntax 
error. Text syntax Is described In the Reference Library documentation for ASCII."L, 
translatable: TRUE, 
id: 34], 

charsOutOfBounds: [ 

msgKey: CvSTC.MessageKey.charsOutOfBounds.ORD, 

msg: XStrlng.FromSTRING["The line length limit must be between 10 and 256 characters, inclusive. Please reenter,"L], 
type: errorMsg, 

translationNote: "Posted when user tries to Done or Start a sheet with an Invalid numeric value."L, 
translatable: TRUE, 

Id: 35], 
fatalError: [ 

msgKey: CvSTC.MessageKey.fatalError.ORD, 

msg: XString.FromSTRING[" conversion failed with an unrecoverable error "L], 
type: errorMsg, 

translationNote: "Posted if NSFile or other error in conversion. Note that leading and trailing blanks are required,"L, 
translatable: TRUE, 
id: 36], 
extraErrO: [ 

msgKey: CvSTC.MessageKey.extraErrO.ORD, 

msg: XString,FromSTRINGf" Unrecoverable Chinese Telegraph Code conversion error: damaged converter icon. "L], 
type: errorMsg, 

translationNote: "Blanks are required. Posted If the conversion cannot read properties from the converter 1con."L, 
translatable: TRUE, 

Id: 37], 
extraErrl: [ 

msgKey: CvSTC.MessageKey.extraErrl.ORD, 

msg: XStrlng.FromSTRING["The number in the highlighted field Is Invalid. Please reenter."L], 
type: errorMsg, 

translationNote: "Posted when the user tries to Done or Start a sheet with text In a numeric field."L, 
translatable: TRUE, 
id: 38], 

df1tVAEndLine: [ 

msgKey: CvSTC.MessageKey.dfltVAEndLine.ORD, 
msg: XString.FromSTRING["<CR>"L]. 
type: others, 

translationNote: "do not translate, default value for text items"L, 
translatable: FALSE, 
id: 39], 

dfltVAEndParagraph: [ 

msgKey: CvSTC.MessageKey.dfltVAEndParagraph.ORD, 
msg: XString.FromSTRING["<CR>"L], 
type: others, 

translationNote: "do not translate, default value for text items"!., 
translatable: FALSE, 

Id: 40], 

dfitVAReplaceCharacter: [ 

msgKey: CvSTC.MessageKey.dfltVAReplaceCharacter.ORD, 
msg: XString.FromSTRING["?"L], 
type: others, 

translationNote: "do not translate, default value for text 1tems”L, 
translatable: FALSE, 

Id: 41] 


1: C 

msgKey: CvSTC.MessageKey.USEAGAINTOREPLACETHISSTRING.ORD, 
msg: XString.FromSTRING["«»"L], 
type: «», 
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translatlonNote: "«» , 'L, 
translatable: TRUE, 
id: «»], 

» 

]; 

XMessage.RegisterMessage$[h, LOOPHOLE[LONG[DESCRIPTOR[msgArray]]], FALSE]; 


--/* MAIN line code */ 

InitMessages[! NSFile.Error, Runtime.UnboundProcedure => NoMessageFIle]; 
END. . . 


LOG 


24-Apr~85 12:12:27 - MSchneider - CREATED from SampleBWSApplIcationMsgFilelmpl 

10-May-85 10:56:18 - MSchneider - used correct ApplicationFolder name 

28-May-85 9:28:54 - MSchneider - moved localZone into procedure, added use of BWSZone 

24-.]uri-85 14:33:55 - MSchneider - made "MessageFIle" be "MessageFile" In entry name 

9-Jul-85 11:12:31 - MSchneider - added ERROR NoMessageF11e 

26-Feb-87 14:59:12 - Caro - Upgraded to VP 2.0 (delete 90% of code) 

8-Apr-87 11:43:56 - Caro - Catch ANY error raised from InitMessages 

26-ilun-87 11:10:51 - Caro - Made #44 a real error 

19-Aug-87 10:51:37 - Caro - Reworded several messages and transNotes 

24-Nov-87 17:01:04 - Erickson - added aToVDfltMeta (ID = 46) to change default for ascii to Viewpoint treatment of paraEndsWIth. 

17-Dec~87 16:04:02 - Erickson - AR 16414 - made #45 a real error, bad number Input. 
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-- File: CvSTCParselmpl.mesa 

-- 10-Feb-89 22:18:01 

— Last Revised by: Caro 29-Jun-87 11:31:40 

-- Owner: Workstation Applications - Foreign Conversion Team 

-- Copyright (c) 1987, 1989 by Xerox Corporation. All rights reserved. 

DIRECTORY 

USING [CR, FF, LF, TAB], 

Attention 

USING [Post], 

CvSTC 

USING [Common, GetMessage, MessageKey], 

ForinWIndow 

USING [SetSelectlon, SetlnputFocus], 

Str 1 ng 

USING [AppendChar, CopyToNewStrlng, MakeString, StrlngBoundsFault], 

XChar 

USING [Character, Code, not], 

XStrlng 

USING [AppendChar, ClearWrlter, CopyToNewReaderBody, 

Empty, Equal, First, FromSTRING, FreeReaderBytes, FreeWriterBytes, 

InvalIdEncodlng, Lop, NewWrlterBody, 

Reader, ReaderBody, ReaderFromWrlter, ValIdateReader, Writer, WrlterBody]; 


« 


-- OVERVIEW: 

Parse text Items containing meta characters into strings. 


» 


CvSTCParselmpl: PROGRAM 
IMPORTS 

Attention, CvSTC, FormWIndow, String, XChar, XString 
EXPORTS 
CvSTC = 

BEGIN 


— CONSTANTS 


max: CARDINAL = 10; 

maxAbbr: CARDINAL = 3; --/* abbreviations only up to 3 characters */ 

maxQctals: CARDINAL = 3; —/* need exactly 3 octal digits */ 


TYPES 


ParseStates: TYPE - { 
entry, 
beglnMeta, 
doOctal, 
doAbbrev 
}: 

— -*3»sxaass = = s = szxax = s 

— SIGNALS 


ParseError: SIGNAL [err: ErrType syntaxError, start, pos: CARDINAL] - CODE: 

ErrType: TYPE = 

{ 

syntaxError, 

InvalIdMeta, 
unknownAbbr, 
invalIdOctal, 

InvalIdEncodlng 

}; 


— PUBLIC PROCEDURES 


Parseltem: PUBLIC PROC [my: CvSTC .Common, r: XString. Reader, item: CvSTC .MessageKey, buf: XString .Writer *■ NIL] RETURNS [ok: 
LONG STRING] = { 

bufRb: XString.WrlterBody: 
tmpRb: XString.ReaderBody; 
msgRb: XString.ReaderBody; 
cllentBuf: BOOLEAN; 

IF buf = NIL THEN 

{ 

bufRb «■ XString. NewWriterBody[maxLength: 30, z: my.z]; 
buf *■ QbufRb; 
cl lentBuf <- FALSE ; 

} 

ELSE 

client8uf «■ TRUE; 

BEGIN 

ENABLE ParseError => 


BOOLEAN, Is: 
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{ 

msgRb <- CvSTC .GetMessage[metaError] ; 

IF my.window * NIL OR item = CvSTC.MessageKey.FIRST THEN GOTO notOK; 

FormWindow.SetSelect1on[ 
window: my.window. 

Item: Item.ORD, 
flrstChar: start, 
lastChar: pos]; 

FormWindow.SetInputFocus[ 
window: my.window. 

Item: Item.ORD, 
beforeChar: pos]; 

Attention.Post[@msgRb]; 

is <- NIL: 

GOTO notOK; 

}: 


tmpRb <- XString.CopyToNewReaderBody[r: r, z: rny.z]; 
Is <- ParseToLS[text: QtmpRb, z: rny.z, buf: buf]; 


--/* test for invalid encoding */ 

IF my.owner » AtoVdst THEN 

{ 

msgRb * XStrlng. FromSTRINGfls] ; 

XString.ValidateReader[@msgRb ! XStrlng.InvalidEncodlng => 
SIGNAL ParseError[ 
err; InvalIdEncodlng, 

Start: 0, 

pos: CARDINAL.LAST]]; 

}: 


ok <- TRUE; 

EXITS notOK => ok <■ FALSE; 

END; 

IF NOT clientBuf THEN 

XStr1ng.FreeWriterBytes[buf]; 

XStrlng.FreeReaderBytes[r: @tmpRb, z: rny.z]; 


~ PROCEDURES 


ParseToLS: PROC [text; XStrlng.Reader, z; UNCOUNTED ZONE, buf: XStrlng.Writer] RETURNS [Is: LONG STRING «■ NIL] = { 
rb; XStrlng .ReaderBody *- CvSTC.GetMes$age[left] ; 
state: ParseStates «- entry; 
start, 

pos; CARDINAL «■ 0; 
octals, 

abbrs: CARDINAL <- 0; 
cr: XStrlng.ReaderBody; 

If: XStrlng.ReaderBody; 
nl: XStrlng.ReaderBody; 
ff: XString.ReaderBody; 
tab: XString.ReaderBody; 
left: XChar.Character; 
right: XChar.Character; 
xc; XChar.Character; 
c: CHARACTER; 

octal Value: CARDINAL[0.,255]; 

—/* get < and > */ 
left «• XString . First[@rb] ; 
rb *■ CvSTC.GetMessage[right] ; 
right <■ XString,First[@rb] ; 

—/* initialize strings */ 

IF XStrlng.Empty[text] THEN 
RETURN[1s: NIL] 

ELSE 

Is «• String.MakeStrlng[z: z, maxlength: max]; 
cr «- CvSTC .GetMessage[cr] ; 

If * CvSTC.GetMessage[lf]; 
nl «■ CvSTC .GetMessagefnl ] ; 
ff + CvSTC.GetMessage[ff] ; 
tab *■ CvSTC .GetMessage[tab] : 

--/* lop through string */ 

DO 

ENABLE 

c 

String.StringBoundsFault => 

{ 

ns «■ String .CopyToNewString[s: Is, z: z, longer: max]; 
z.FREE[@ls]; 

Is <- n$; 

RESUME[ns]; 

}i 

UNWIND => 

{ 

IF Is # NIL THEN z.FREE[@ls]; 

}; 

}s 
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xc «■ XStrlng,Lop[text] ; 

IF xc 3 XChar.not THEN 

{ 

IF state = entry THEN 
EXIT 

ELSE 

SIGNAL ParseError[err: syntaxError, start: start, pos: pos]; 


SELECT state FROM 
entry =»> 

c 

IF xc = left THEN 

state «■ beglnMeta 

ELSE 

{ 

c «■ L00PH0LE[XChar.Code[xc], CHARACTER]; --/* only Charset 0 V 
String,AppendChar[s: Is, c: c]; 
state <- entry; 

}; 

pos *• pos + 1; 

}: 

beginMeta => 

c 

start «- pos; 

c <■ LOOPHOLE [XC ha r .Codefxc], CHARACTER]; —/+ only Charset 0 */ 

SELECT c FROM 

IN [ f O..*3] => 

{ 

state doOctal ; 
octals «■ Is 
octal Value *■ c - '0; 

}: 

•C. •F, ’L, 'N, 'T, •< => 

C 

state <• doAbbrev; 

XString.ClearWriter[buf]; —/* collect abbreviation here */ 

XStrlng.AppendChar[to: buf, c: xc]; 
abbrs «- 1; 

}; 

ENDCASE => 

SIGNAL ParseError[err: InvalidMeta, start: start, pos: pos]; 
pos +• pos + 1; 

}S 

doOctal => 

{ 

c <- LOOPHOLE[XChar.Code[xc], CHARACTER]; --/* only Charset 0 */ 

IF xc = right THEN 

{ 

IF start = pos THEN 

SIGNAL ParseError[err: invalidMeta, start: start, pos: pos + 1]; 
IF octals < maxOctals OR octalValue > 377B THEN 

SIGNAL ParseError[err: InvalIdOctal, start: start, pos: pos]; 
c «• LOOPHOLE [octal Val ue , CHARACTER]; 

String.AppendChar[s; Is, c: c]; 
state entry; 

> 

ELSE IF octals >= maxOctals THEN 

SIGNAL ParseError[err: invalIdOctal, start: start, pos: pos] 

ELSE IF NOT c IN [’0. . ’7] THEN 

SIGNAL ParseError[err: InvalIdOctal, start: start, pos: pos] 

ELSE 

c 

octalValue <- (octalValue * 8) + (c - ’0); 
octals <- octals + 1; 
state 4* doOctal; 

}; 

pos «■ pos + 1: 

}: 

doAbbrev => 

c 

IF xc = right THEN 

{ 

tmp: XString .Reader <- XString.ReaderFromWriter[buf] ; 

IF start = pos THEN 

SIGNAL ParseError[err: InvalidMeta, start: start, pos: pos + 1]; 
IF abbrs > maxAbbr THEN 

SIGNAL ParseError[err: unknownAbbr, start: start, pos: pos]: 
SELECT TRUE FROM 

XStrlng,Equal[rl: tmp, r2: Qcr] => 

String,AppendChar[s: Is, c: Ascii.CR]; 

XString.Equal[rl: tmp, r2: @lf] => 

String,AppendChar[s: Is, c: Ascii.LF]; 

XString.Equal[rl: tmp, r2: @nl] => 

C 

String.AppendChar[s: Is, c: Ascii.CR]; 

String,AppendChar[$: Is, c: Ascii.LF]; 

}i 

XStrlng . Equal[rl: tmp, r2 ; @tab] ='> 

String.AppendCharfs: Is, c: As i i.TAB]; 

XStrlng.Equal[rl: tmp, r2: Off] => 

String.AppendChar[s: Is, c: Ascii.FF]; 
abbrs = 1 AND c = '< => 

String.AppendChar[s: Is, c: '<]; 

ENDCASE > 

SIGNAL ParseError[err: unknownAbbr, start: start, pos: pos]; 
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state *■ entry; 

} 

ELSE 

C 

XStrlng.AppendChar[to: buf, c; xc]; 
abbrs <- abbrs + 1; 
state *■ doAbbrev; 

}; 

pos •• pos + 1: 

}; 

ENDCASE; 

ENDLOOP; 

}: 


END... 

LOG 

lG-Mar-87 14:06:16 - Caro - Created 

26-.Jum-87 11:28:54 - Caro - Added test for MessageKey.FIRST to Parseltem 
2Q-.Junt-87 11:33:00 - Caro - Added validation to Parseltem 
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-- File: CvSTCToVPImpl.mesa 

— Conversion of Chinese Telegraph Code (either STC or CTC) to Hanzl 
-- Trow ll-Sep-89 12:30:26 

-- Last Revised by: Shinsato 12-Feb-88 13:00:11 

-- Owner: Workstation Applications - Foreign Conversion Team 

-- Copyright (c) 1987, 1988, 1989 by Xerox Corporation. All rights reserved. 

DIRECTORY 

Ascii 

USING [CR, FF, LF, NUL, SP, TAB], 

BackgroundProcess 

USING [ResetUserAbort, UserAbort], 

BWSZone 

USING [shortLIfetlme, Permanent], 

Catalog 

USING [beforeLogonSesslon, GetFile], 

Converter 

USING [ConvertProc, CvData, DependentOptlonProc, GetPOptlon, PostMessage], 

ConverterMsg, 

CvSTC, 

DocInterchangeDefs 

USING [AppendNewParagraph, AppendPageBreak, AppendText, CheckAbortProc, 

Doc, Error, FIn1$hCreation, FlnlshCreatlonStatus, 

PaglnateOptlon, StartCreation, StartCreationStatus], 

DocInterchangePropsDefs 

USING [Family, FontPropsRecord, GetFontPropsDefaults, GetPagePropsDefaults, 

GetParaPropsDefaults, PagePropsRecord, ParaPropsRecord, modern, classic], 

Environment 

USING [Block, Byte, bytesPerPage, wordsPerPage] , 

NSFile 

USING [Close, Error, Find, GetReference, Handle, Logoff, 
nullHandle, nul1 Reference , OpenByReference , Reference, Session], 

NSFileStream 

USING [Create, Handle], 

NSSegment 
USING [Map], 

NSString 

USING [FreeString, String], 

Space 

USING [ScratchMap, Unmap], 

Stream 

USING [CompletionCode, Delete, GetBlock], 

String 

USING [AppendChar, AppendStrlng, FreeString, MakeString, StringToDecimal], 

TIP 

USING [ResetUserAbort, UserAbort], 

XChar 

USING [Make, not], 

XCharSetO 

USING [Make], 

XCharSet41Extra 
USING [Make], 

« 

XCharSet357 
USING [Make], 

» 

XMessage 

USING [Get, Handle], 

XStrlng 

USING [AppendChar, AppendSTRING, ByteLength, 

Character, CharacterLength, ClearWrlter, FreeWrlterBytes, 

FromSTRING, InvalIdEncodlng, NewWrlterBody, NSStringFromReader, Reader, ReaderBody, ReaderFromWrlter, 
Writer, WriterBody, Writerlnfo]; 


« 


-- OVERVIEW: 

Chinese telegrahph code (In ASCII) to VP conversion. 


CvSTCToVPImpl: PROGRAM 
IMPORTS 
Catalog, 

NSSegment, XMessage, 

BackgroundProcess, BWSZone, Converter, ConverterMsg, CvSTC, 
DocInterchangeDefs, DocInterchangePropsDefs, 

NSFile, NSFileStream, NSString, Space, Stream, String, 

TIP, XChar, XCharSetO, XCharSet41Extra, XString 
EXPORTS 
CvSTC = 

BEGIN 


-- CONSTANTS 


maxPara: CARDINAL = 8 * 1024; 

bufPages: CARDINAL = (maxPara + Environment.bytesPerPage - 1) / Environment.bytesPerPage; 
paraLen: CARDINAL = maxPara/4; 

words: CARDINAL = SIZE[CtoVPCharMap]; 

stopsAt: CARDINAL = 5; --/+ tab stops every five characters */ 
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tabStopCount: CARDINAL a (132/$topsAt)+l; --/* 132 columns max */ 

aHyphen: CHARACTER => 055C; 

xNewLlne: XStrlng.Character = XCharSetO.Make[newLine]; 
xSpace: XStrlng.Character » XCharSetO.Make[space]; 

xLeftDoubleGul 1lemet: XStrlng.Character = XCharSetO.MakepeftDoubleGull lemet]; 
xRIghtDoubleGulllemet: XStrlng.Character = XCharSetO.Make[r1ghtDoubleGulllemet]; 


— TYPES 


AVDttta: TYPE = LONG POINTER TO AVDataObj; 

AVDataObj: TYPE => RECORD [ 
source: NSF11e.Handle, 

Input: NSFIleStream.Handle, —/* created from source */ 

cvData: Converter.CvData, 
session: NSFlle.Session, 

src: CvSTC.Common, —/* common data distinguished by owning formwindow */ 

dst: CvSTC.Common, 
background: BOOLEAN, 

fontProps: DocInterchangePropsDefs.FontPropsRecord, 
paraProps: DocInterchangePropsDefs.ParaPropsRecord, 
pageProps: DocInterchangePropsDefs.PagePropsRecord, 
doc: DocInterchangeDefs.DOC, 

blk: Environment.Block, —/* primary input buffer ♦/ 

state: AVState, 
z: UNCOUNTED ZONE]; 

—/+ the various states of the StateMachine */ 

AVState: TYPE = 

c 

entry, 

append, 

IgnoreTrailing, 
maxExceeded, 
endPara 

}s 

CtoVPCharMap: TYPE = ARRAY CHARACTER OF XStrlng.Character; 

TelegraphCode: TYPE = CARDINAL [0..9999]; 

TelegraphCodeTable: TYPE = LONG POINTER TO ARRAY TelegraphCode OF XStrlng.Character; 


-- GLOBALS 


Global: TYPE = RECORD [ 

Isomap: LONG POINTER TO CtoVPCharMap, 
pz: UNCOUNTED ZONE]; 

g: Global; 

prc: TelegraphCodeTable «* NIL; 
roc: TelegraphCodeTable <- NIL; 


-- PUBLIC PROCEDURES 


AscllToVP: PUBLIC Converter.ConvertProc = { 

<< = PROCEDURE [source: NSFi1e.Hand!e, cvData: Converter.CvData, session: NSFlle.Session, srclnstance: LONG POINTER «- NIL, dstlnstance: 
LONG POINTER * NIL, background: BOOLEAN <- FALSE] RETURNS [dest: NSFi le. Handl e <- LOOPHOLE[OJ]; 

» 

ENABLE CvSTC.Problem, NSFIle.Error, XStrlng.InvalidEncoding => 

c 

msgRb: XStrlng.ReaderBody *■ CvSTC.GetMessage[fatalError] ; 

Post[msgRb, cvData]; 

CONTINUE: 

}; 


IF source = NSFlle.nullHandle THEN RETURN; 

dest «• AtoV[source, cvData, session, srclnstance, dstlnstance, background]; 

« 


Both DependentOptlonProcs create Instance data with CreateCommon. The data is distinguished by the owner variable. The CommonObj within 
CvSIC.CommonData Is the data structure written to the client file stured as the icon properties. Only those fields pertaining to the 
owner are used. 


» 

AsdIToVPSrcOps: PUBLIC Converter.DependentOptlonProc = { 

<< = PROCEDURE [options: BOOLEAN «- TRUE, cvData: Converter.CvData, which: Converter.FormatToUse, srcFormat: XStrlng.Reader, destFormat: 
XString.Reader, window; W1ndow,Handle, oldlnstance: LONG POINTER «■ NIL] RETURNS [menuItemProc: Converter.MenuItemProc, destroy: 
Converter.DestroyProc, instance: LONG POINTER]; 

» 

owner: CvSTC.Owners AtoVsrc; 

menuItemProc *■ CvSTC .CommonMenu ; 
destroy <- CvSTC .DestroyCommon; 

IF oldlnstance = NIL THEN 
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Instance *■ CvSTC .CreateCommon[cvData, options, window, owner ! NSF11 e. Error, CvSTC. Probl em => {owner «- backstop; instance «- NIL; 
CONTINUE}] 

ELSE 

{ 

my; CvSTC.Common +■ oldlnstance; 

my.window <- window; --/* AR 13535: update window handle */ 

Instance +■ my; 

}: 


--/* make formwindow */ 

CvSTC.CreateFW[1nstance, window, owner]; 


AscMToVPDstOps: PUBLIC Converter.DependentOptionProc a { 

<< « PROCEDURE [options: 800LEAN <- TRUE, cvData: Converter.CvData, which: Converter.FormatToUse, srcFormat: XString.Reader, destFormat: 
XString.Reader, window: Window.Handle, oldlnstance: LONG POINTER «■ NIL] RETURNS [menuItemProc: Converter.MenuItemProc, destroy: 
Converter.DestroyProc, Instance: LONG POINTER]; 

» 

owner: CvSTC.Owners «■ AtoVdst; 

menuItemProc CvSTC.CommonMenu; 
destroy *• CvSTC .DestroyCommon ; 

IF oldlnstance = NIL THEN 

Instance <- CvSTC .CreateCommon[cvData, options, window, owner ! NSFile.Error, CvSTC. Problem -> {owner <- backstop; instance *■ NIL; 
CONTINUE}] 

ELSE 

c 

my; CvSTC.Common «- oldlnstance; 

my.window «■ window; --/* AR 13535: update window handle */ 
instance *• my; 

}: 

—/* make formwindow ♦/ 

CvSTC.CreateFW[instance, window, owner]; 


-- PROCEDURES 


AtoV: Converter.ConvertProc = { 
aborted: BOOLEAN «• FALSE; 

start: DocInterchangeDefs.StartCreatlonStatus «• lastAval1 able; 
finish: DocInterchangeDefs .FlnlshCreatlonStatus <- lastAvallable; 
avData: AVDataObj; 

pOption: DocInterchangeDefs.PaglnateOptlon; 
docSesslon: NSFile.Session; 
dst, 

src: CvSTC.Common *• NIL; 

1 IneHtlnPoInts: CARDINAL <- 18; 

--/* local proc */ 

POption: PROCEDURE RETURNS [DocInterchangeDefs.PaglnateOptlon] = INLINE 

{ 

SELECT Converter.GetPOpt1on[] FROM 
compress => RETURN[compress]; 
simple => RETURN[simple]; 
none => RETURN[none]; 

ENDCASE => ERROR; 

}; 


--/* begin code */ 

--/* Initialize Instance data */ 

IF dstlnstance = NIL THEN --/♦ ASSERT: srclnstance also NIL */ 

{ 

ENABLE NSFile.Error, CvSTC.Problem => 

( 

msgRb; XString.ReaderBody «■ CvSTC.GetMes$age[extraErrO]; —* Unrecoverable ASCII conversion error: damaged converter Icon. 

Converter.PostMe$sage[ 
msg: SmsgRb, 
cvData: cvData, 
cr; FALSE, 
clear: FALSE]; 

IF src # NIL THEN CvSTC.DestroyCommon[src]; 

GOTO terminate; 

}: 

key: CvSTC .MessageKey <- CvSTC .MessageKey. FIRST; 

—/* assume both are NIL */ 

src <- CvSTC,CreateCommon[cvData, FALSE, NIL, AtoVsrc]; 
dst <- CvSTC.CreateCommon[cvData, FALSE, NIL, AtoVdst]; 

src.text[para£nd$With] «■ CvSTC.Parseltem[ 
my: src, 

r; 0src.textRb[paraEndsW1th], 

Item: key].Is; 

dst. text[atovReplaceUnknown] «- CvSTC . Parseltem[ 
my: dst, 

r: @dst.textRb[atovReplaceUnknown], 

Item: key].Is; 

EXITS terminate => RETURN; 

} 

ELSE 

{ 

src *- srclnstance; 
dst «• dstlnstance; 
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avData «- [ 

source: source* 

Input: [NIL], 
cvData: cvData, 
session: session, 
src: src, 
dst: dst, 

background: background, 
fontProps: TRASH, 
paraProps: TRASH, 
pageProps: TRASH, 
doc: TRASH, 

b1k: [Space.ScratchMap[count: bufPages], 0, maxPara], 
state: entry, 
z: d s t. z ]; 


BEGIN 

ENABLE 

{ 

DocInterchangeDefs.Error => GOTO err; 

UNWIND => 

{ 

avData.blk.blockPointer «- Space.Unmap[pointer: avData.blk.blockPointer]; 
IF srclnstance = NIL THEN CvSTC.DestroyCommon[src]: 

IF dstlnstance = NIL THEN CvSTC.De$troyCommon[dst]; 
src «■ dst <- NIL; 

}S 


—/* open stream on source */ 
avData. Input *■ NSFileStream.Create[ 
file: avData.source, 
closeOnDelete: FALSE, 

session: avData. session ! NSFile. Error => (avData. Input <- [NIL]; GOTO err}]; 

—/* initialize */ 
pOptlon «■ POpt1on[]j 

DocInterchangePropsDefs.GetFontPropsDefaults[0avData.fontProps]; 

DocInterchangePropsDefs.GetParaPropsDefaults[6avData.paraProps]; 

DocInterchangePropsDefs.GetPagePropsDefaults[@avData.pageProps]; 

--/* apply Initial parms */ 

SELECT avData.dst.f.font FROM 

CvSTC .modern => avData.fontProps.fontDesc.family «• DocInterchangePropsDefs .modern; 
CvSTC .classic => avData. fontProps .fontDesc .family «• DocInterchangePropsDefs.classic; 
ENDCASE; 

SELECT avData.dst.f.fontSlze FROM 
CvSTC.twelve => 

c 

avData.fontProps .fontDesc.poIntSIze «• 12; 
avData.paraProps .baslcProps . 1 IneHelght *■ 18; 

1 IneHtlnPolnts *■ 18; 

avData .paraProps .basicProps . defaul tTabStopSpacIng <- (stopsAt * 12); 

)i 

CvSTC.twentyFour => 

{ 

avData.fontProps.fontDesc.pointSIze «- 24; 
avData .paraProps .baslcProps . 1 IneHelght *■ 30; 
lineHtlnPoints <- 30; 

avData.paraProps .baslcProps .defaul tTabStopSpacIng «- (stopsAt * 24); 

>; 

ENDCASE; 

--/* set paragraph leading by counting CRs In paraEndsWith string */ 

BEGIN 

lcount: CARDINAL *■ 0; 

eop: LONG STRING <- avData. src. text[paraEndsW1th] ; 

IF eop # NIL THEN 

FOR 1: CARDINAL IN [0..eop.length) DO 

IF eop[i] = Ascii.CR THEN lcount * lcount + 1; 

ENDLOOP; 

IF lcount > 1 THEN 

avData. paraProps. baslcProps .preLeadlng «■ lineHtlnPoints * (lcount - 1) / 2 
ELSE 

avData.paraProps.basicProps.preLeading «■ 0; 
avData.paraProps .baslcProps .postLeading <- 0; 

END; 

--/* StartCreation checks process priority to determine forkedness */ 

[doc: avData.doc, status: start] «■ DocInterchangeOefs.StartCreatlon[ 
paglnateOption: pOption, 

InitialFontProps: SavData.fontProps. 

InitialParaProps: OavData.paraProps, 

InitialPageProps: SavData.pageProps ! NSFile.Error => { 

IF error = [space[medlumFul1]] THEN 
start *■ notEnoughDiskSpace 
ELSE 

start <r las tAvailable ; 

CONTINUE}]; 

SELECT start FROM 
Ok -> NULL; 
notEnoughDiskSpace => 
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{ 

Post[ConverterMsg.Get[ConverterMsg.koutOfSpace], avData.cvData]; 

GOTO err; 

}: 

ENDCASE = > 

f 

Post[ConverterMsg.Get[CortverterMsg.kunknownProblem], avData.cvData]; 
GOTO err; 

}s 


-“/* enter state graph +/ 

BEGIN 

ENABLE ABORTED => {aborted «• TRUE; CONTINUE); 

StateMachine[@avData]; 

END; 

—/* paginating */ 

IF pOptlon # none THEN 

mrb: XStrlng.ReaderBody +■ CvSTC.GetMessage[paginat1 ng] ; 
Converter.PostMessage[ 
msg: Qmrb, 
cvData: cvData, 
cr: FALSE, 
clear: FALSE]; 

}: 

—/* user may have partial doc after an abort, so allow paginate/finish +/ 
--/* reset abort tests. User must abort paginate separately. */ 

IF aborted THEN 

{ 

IF avData.background THEN 

BackgroundProcess.ResetUserAbort[] 

ELSE 

TIP,ResetUserAbort[NIL]; 

}: 


--/* paginate and finish */ 

[docFIle: dest, session: docSesslon, status: finish] «■ DocInterchangeDefs.F1nishCreat1on[ 
docPtr: 0avData.doc, 
checkAbortProc: UserAbortsPaginate . 
checkAbortCllentData: OavData]; 

IF finish = aborted THEN 

{ 

aborted *■ TRUE; 

Post[ConverterHsg.Get[ConverterMsg.kuserAbort], cvData]; 

}; 


--/* re-open dest In session */ 

IF dest # NSFIle.nullHandle THEN 

{ 

ENABLE NSFIle.Error => 

{ 

NSFIle.Close[dest. docSession f NSFIle.Error => CONTINUE]; 
dest *- NSFi le. null Handle; 

CONTINUE; 

}; 

tmpRef: NSFile.Reference; 
tmp : NSFIle . Handle *■ dest; 

tmpRef <- NSFIle.GetReference[flie: dest, session: docSesslon]; 

dest «■ NSFIle.OpenByReference[reference: tmpRef, session: avData.session]; 

NSFIle.Close[tmp. docSesslon]; 

--/* if this process Is cllentBackground, docSession must be logged off +/ 
IF background THEN NSFile.Logoff[docSession ! NSFIle.Error => CONTINUE]; 

}; 


EXITS err => NULL; 

END; 

IF avData.input # NIL THEN Stream.Delete[avData.Input]; 

IF avData.blk.blockPointer # NIL THEN 

avData.blk .blockPo Inter *■ Space. Unmap [avData. blk.blockPointer] ; 
--/* destroy Instance data if created by this proc call */ 

IF srclnstance = NIL AND src # NIL THEN CvSTC.DestroyCommon[src]; 

IF dstlnstance = NIL AND dst # NIL THEN CvSTC.DestroyCommon[dst]; 

IF finish # ok OR aborted THEN 

Post[ConverterMsg.GetfConverterMsg. kdataSkipped], cvData] ; 

}: 


CheckAbort: PROC [background: BOOLEAN] RETURNS [yes: BOOLEAN] = INLINE { 
yes * (background AND BackgroundProcess.UserAbort[]) OR 
(NOT background AND TIP.UserAbort[NIL]); 

}: 


FlushText: PROC [av: AVData, para: XString.Writer] = { 
r: XString .Reader «- XString.ReaderFromWriter[para]; 

IF CheckAbort[av.background] THEN ERROR ABORTED; 

IF XString.ByteLength[r] > 0 THEN 

{ 

DocInterchangeDefs.AppendText[ 
to: [doc[av.doc]], 
text: r, 

textEndContext: XString .Writerlnfofpara] .endContext, 
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fontProps: @av.fontProps]; 
XString.ClearWriter[para]; 

}; 


Post: PROC [msgRb: XString.ReaderBody, cvData: Converter.CvData] = { 
Converter.PostMessagef 
msg: GmsgRb, 
cvData: cvData, 
cr: TRUE, 
clear: FALSE]; 

}; 


« 


StateMachlne 

This procedure implements a state graph, which is depicted in auxiliary documentation. The state machine handles the input data 
character by character, although the i/o is optimized using block buffers. Note that the XString.Writer "para" is the output buffer 
that gets appended to the document every time text is flushed (see FlushText). Hereafter are described, briefly, the states, the entry 
conditions, exit conditions, and special circumstances: 

- entry 

The state machine is always entered here. The entry conditions are that the index "n" references the next character to be handled. The 
next state Is determined by the value of the character "c”. The mode "ignore" determines whether white space is treated as standard 
text, or as should be handled by the special IgnoreTra iling state. If the character "c" matches the first character of the end of 
paragraph string "eopO", then the next state is endPara. Otherwise, the next state is "append". Note that the variable "nextState” 
does NOT refer to the state executed after entry, but rather the state that the next state RETURNS TO. Although this violates strict 
state machine implementation algorithms, It saves logic. 

- append 

The state is entered with the character "c", and a valid nextState. It translates the character ”c" to a VP character, and appends It to 
the output buffer "para". Certain special cases are handled, The exit condition is a valid nextState, which becomes "state". 

- IgnoreTral11ng 

The purpose of this state Is to Implement deletion of white space that precedes an end of line sequence, If the user so desires. The 
state is entered either from entry with "c" being whitespace, or from igno reTrail ling, with "n" indicating the next character to handle. 
Variables are Initialized to indicate the beginning of whitespace characters. The state is exited If eopO Is found, or a nonwhitespace 
character Is found before the end of line. 

- maxExceeded 

This state handles an overflow exception. It is entered If "para" is about to exceeded its limits. A new paragraph is forced if this 
state is entered. It returns to entry. 

- endPara 

This state tries to determine if the end of a paragraph has been found. It is entered if the character "c" matched eopO, or (from 
endPara itself) If the Input text continues to match the string "s". If a paragraph ending is found, the paragraph is flushed. The 
state returns to entry either if there Is a complete match, or of there is a mismatch. Several special cases are handled. 

The state machine loops until input is exhausted. 


» 


StateMachine: PROC [av: AVData] = { 
lastBlock: BOOLEAN *• FALSE; 

flushed: BOOLEAN *■ FALSE; --/* controls appending text to doc */ 
ignore: BOOLEAN <- av . dst.f. ignoreTrail ing. value ; 
includeTelCodes : BOOLEAN «■ av . dst. f. IncludeTelCodes.value ; 
eop: CARDINAL «• 0; —/* index into paraEndsWith string */ 

para: XString.WrlterBody <- XString.NewWriterBody[maxLength: paraLen, z: av.z]; 
digits: LONG STRING *■ String,MakeString[maxlength: 100, z: av.z]; 
telCodes: LONG STRING <- String .MakeStr1ng[maxlength: (5 * paraLen), zt av.z]; 
state: AVState «* entry; 

blartkCount: CARDINAL «* 0; --/* count of "white" characters In buffer */ 

blkCount: CARDINAL <- 0; —/* number of blocks read */ 

lastBlkCount: CARDINAL; —/* for saving "blkCount" */ 

nextState; AVState; —/* the state a state goes back to V 

getNextBlock: BOOLEAN; 

bytes: CARDINAL; 

why: Stream.CompletionCode; 

eopO: CHARACTER; --/* first character of end-of-paragraph text ♦/ 
unknown: LONG STRING; --/* copy of user defined replacement text */ 
blanksStart: CARDINAL; —/♦ index Into buffer for beginning of blanks */ 
map: LONG POINTER TO CtoVPCharMap; 

blk: LONG POINTER TO PACKED ARRAY INTEGER[0..0) OF Environment.Byte; 
n: CARDINAL; --/* current character in blk */ 

1 ast, 

lastFlush, 
c: CHARACTER; 

stc: TelegraphCode «• 0; -- current STC value 

xc: XString Character; -- converted STC 

convertSTC: BOOLEAN *■ TRUE; 

goodStc: BOOLEAN <- TRUE; 

codes: CARDINAL; 

tct: TelegraphCodeTable; 

FlushSTC: PROCEDURE = { 

Period: TYPE = {month, hour, day, none}; 
period: Period; 
decade: CARDINAL [0..3]; 
digit: CARDINAL [0. .9]; 

IF digits.length = 0 THEN RETURN; 

IF (digits.length = 4 AND convertSTC) THEN { 
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goodStc «* TRUE; 

String,AppendStr1ng[from: digits, to: telCodes]; 
codes *■ codes + 1; 

String.AppendChar[s: telCodes, c: Ascii.SP]; 

IF codes MOD 5=0 THEN String,AppendChar[s: telCodes, c: Ascii.SP]; 

IF codes MOD 10 = 0 THEN String.AppendChar[$: telCodes, c: Ascii.SP]; 
stc <- String.Str1ngToDec1mal[d1g1ts]; 

IF (xc * tct[stc]) => XChar.not THEN { 

IF av.src.f.avCodeScheme = CvSTC.Stc THEN { 
period *• none; 

SELECT stc FROM 

IN [9701. .9712] =■> { 
period «- month; 
digit <- ste MOD 10; 
decade <- (stc / 10) MOD 10; 

}: 

IN [9800,.9824] => { 
period «■ hour; 
digit <• stc MOD 10; 
decade «■ (stc / 10) MOD 10; 

IF stc 3 9800 THEN XStr1ng.AppendChar[to: @para, c; XChar,Make[41B, 738], extra; paralen]; 

}; 

IN [9901..9931] => { 
period «- day; 
digit stc MOD 10; 
decade <- (stc / 10) MOD 10; 

}: 

9999 => { 

IF last ff Ascii.CR AND nextState # endPara THEN 

XStr1ng.AppendChar[to: Qpara, c; xNewLlne, extra; paraLen]; 

}; 

ENDCASE => { 

FOR 1: CARDINAL IN [0.. unknown . length.) DO 

XStrlng.AppendChar[to: Qpara, c; map[unknown[1]] , extra; paraLen]; 

ENDLOOP 


}: 

IF period M none THEN { 

SELECT decade FROM 

1 => XStrlng.AppendChar[to: @para, 

2 => XStrlng.AppendChar[to: Qpara, 

3 => XStrlng.AppendChar[to; Gpara, 
ENDCASE; 

SELECT digit FROM 

1 => XStrlng.AppendChar[to: 


Gpara, 
@para, 


XChar.Make[241B, 101B], extra; paraLen]; 
XChar.Make[322B, 323B], extra; paraLen]; 
XChar.Make[256B, 324B], extra: paraLen]; 


2 => XString.AppendChar[to: 

3 => XStrlng.AppendChar[to: @para, 

4 => XStrlng,AppendChar[to: @para, 

5 => XStrlng.AppendChar[to: Opara, 

6 => XStrlng.AppendChar[to: @para, 

7 => XStrlng,AppendChar[to: Qpara, 

8 => XStrlng.AppendChar[to: @para, 

9 => XString.AppendChar[to: Qpara, 
ENDCASE; 

SELECT period FROM 

month => XStrlng.AppendChar[to: @para, 
hour => XString.AppendChar[to: @para, 
day => XStrlng.AppendChar[to: Opara, c 
ENDCASE; 


XChar 

XChar 

XChar 

XChar 

XChar 

XChar 

XChar 

XChar 

XChar 


.Make[241B, 
.Make[241B, 
,Make[241B, 
.Make[241B, 
.Make[241B, 
.Make[241B, 
,Make[241B, 
.Make[241B, 
.Make[241B, 


42B], 
728], 
113B], 
136B], 
146B], 
302B], 
345B], 
252B], 
360B], 


extra; 
extra: 
extra 
extra 
extra 
extra 
extra 
extra 
extra 


paraLen]; 
paraLen]; 
paraLen]; 
paraLen]; 
paraLen]; 
paraLen]; 
paraLen]; 
paraLen]; 
paraLen]; 


c: XChar.Make[241B, 275B], extra: paraLen]; 
:: XChar.Make[241B, 373B], extra: paraLen]; 
XChar.Make[241B, 132B], extra: paraLen]; 


>; 

} 

ELSE { 

FOR 1: CARDINAL IN [0..unknown.1ength) DO 

XStrlng.AppendChar[to: Qpara, c: map[unknown[i]], extra: paraLen]; 
ENDLOOP 


} 

} 

ELSE 


— kanjl zero 


XStrlng.AppendChar[to: @para, c; xc, extra: paraLen]; 

} 

ELSE { 

IF lastFlush = Ascii.SP AND -goodStc THEN XStrlng.AppendChar[to: @para, c: map[Asci1,SP], extra: paraLen]; 
XStrlng.AppendSTRING[to: @para, from: digits, extra: paraLen]; 
goodStc «■ FALSE; 

}; 

digits , 1 ength *■ 0; 
lastFlush *■ c; 

}; -- FlushSTC 


FlushTelCodes: PROCEDURE = { 

family: DocInterchangePropsDefs . Family *- av . fontProps . fontDesc . family; 
polntsize: CARDINAL «- av .fontProps. fontDesc. poi ntSize: 

UneHelght: CARDINAL «■ av.paraProps.basicProps.1IneHeight; 
preLeading: CARDINAL <- av. paraProps . has i cProps . preLeading ; 
postLeadlng: CARDINAL <- av .paraProps .basicProps. postLeadl ng; 


IF telCodes.length = 0 THEN RETURN; 

IF IncludeTelCodes THEN { 

av.fontProps.fontDesc.family *■ helvetica; 
av .fontProps . fontDesc . poIntSize *■ 9; 
av.paraProps.basicProps.IlneHeight <- 12; 
av.paraProps.basicProps.preLeadir^ <- 2; 

IF av.dst.f.fontSize = CvSTC.twelve THEN 
av .paraProps .basicProps.postLeading <■ 8 
ELSE 

av.paraProps .basicProps.postLead Ing *- 8; 
FlushText[av, @para]; 
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XString.AppendSTRING[to: Qpara, from: telCodes, extra: paraLen] ; 

DocInterchangeDefs.AppendNewParagraph[ 

to: [doc[av.doc]] , paraProps: @av.paraProps, fontProps: @av.fontProps, nToAppend: 1]; 
FlijshText[av, ©para]; 

av . fontProps . fontDesc. family «■ family; 
av .fontProps. fontDesc.pointSIze *• pointSIze; 
av .paraProps .basIcProps .UneHelght «• UneHeight; 
av.paraProps.basicProps.preLeadlng «* preLeadlng; 
av .paraProps .basIcProps .postLeadlng «• postleading; 

}: 

telCodes .length *■ 0; 
codes «■ 0; 

}; -- flushTelCodes 

—/* Initialize */ 
map <■ g. Isomap ; 

IF av.src.f.avCodeScheme = CvSTC.stc THEN tct «■ prc ELSE tct <- roc; 

—/* para Is a buffer of VP characters that gets appended to the doc */ 

XString.ClearWrlter[@para]; 
digits. 1 ength *- 0; 
telCodes.length *• 0; 
codes «- 0; 

eopO <- IF av.src. text[para£ndsW1th] M NIL THEN 
av.src.text[paraEndsW1th][0] 

ELSE 

Ascii.NUL; 
last «• Ascii .NUL; 

unknown <• av . dst. text[atovRepl aceUnknown] ; 

IF unknown = NIL THEN 

{ 

—/* so we don't have to test for NIL again */ 
unknown *• "?"L; 
unknown . length *■ 0; 

}; 

—/* make sure getNextBlock Is TRUE first time */ 
n * av.blk.stopIndexPlusOne; 
blk <- av.blk.blockPoInter; 

--/* enter state graph */ 

DO 

getNextBlock *• n >= av.blk.stopIndexPlusOne: 

IF getNextBlock THEN 

{ 

IF lastBlock THEN 

c 

--/* might have one last character pending V 
IF state = append THEN 
{ 

nextState <• entry; 

GOTO oneLastLoop; 

}; 

FlushSTC[]; 

FlushText[av, Qpara]; 

FlushTelCodes[]; 

EXIT; --/* state graph */ 

}s 

IF CheckAbort[av.background] THEN ERROR ABORTED; 
av.blk.stopIndexPlusOne «- maxPara; 

[bytesTransferred: bytes, why: why] «- Stream.GetBlock[ 
sH: av.Input, 
block: av.blk]; 
lastBlock «• why 0 normal; 
av.blk.stopIndexPlusOne «- bytes; 
blk <■ av.blk.blockPointer; 
n «■ 0; 

--/* guard against blkCount overflow */ 

blkCount IF blkCount = CARDINAL.LAST THEN 0 ELSE blkCount + 1; 

EXITS oneLastLoop => NULL; 

}! 

SELECT State FROM 
entry => 

c 

—/* get next character *7 
c «■ L00PH0LE[bl k[n] , CHAR]; 

—/* set up next state */ 

SELECT C FROM 

Ascii.SP, Ascii.TAB => IF ignore THEN 

f 

state *• IgnoreTrai 1 ing; 
blanksStart <- n; 
blankCount *■ 0; 
lastBlkCount «■ blkCount; 

> 

ELSE 

{ 

state «■ append; 
nextState *■ entry; 
n *■ n + 1; 

}: 

eopO *> 

{ 

FlushSTC[]; 
state endPara; 
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>: 

ENDCASE => 

£ 

state <- append; 
nextState *• entry; 
n * n + 1; 

}s 

}: 

append => 

{ 

--/* ASSERT: order of select arms Is critically important */ 

SELECT c FROM 

IN ['0. . '9] => — [60C..71C] 

{ 

—/* digits 0 through 9 */ 

IF convertSTC THEN 

String.AppendCher[$: digits, c: c] 

ELSE 

XStrlng.AppendChar[to: Qpara, c: map[c], extra: paraLen]; 
state «- nextState; 

>; 

Ascii.SP => -- 40C 

{ 

IF (last IN [60C..71C] AND convertSTC) THEN FlushSTC[] 

ELSE IF NOT (last = OR last = ’.) THEN 

XString.AppendChar[to: Qpara, c: map[c], extra: paraLen]; 
state «• nextState; 

>: 

=> — 43C, toggle convert switch 

{ 

FIu$hSTC[]; 

convertSTC «■ -convertSTC; 
state *■ nextState;_ 

In(^ 40C . . 176C] . '251C~ 252C , 271C , 272C~^ 4rO . - "Si 

--/* standard characters */ 

FlushSTC[]; 

XStrlng.AppendCharfto: Qpara, c: map[c], extra: paraLen]; 
state *■ nextState; 

>5 

Ascii.CR => 

{ 

FlushSTC[]; 

IF CheckAbort[av.background] THEN ERROR ABORTED; 

IF nextState = entry THEN 

{ 

--/* smart white space */ 

SELECT last FROM 
ASCII.SP, 

Asd 1 .TAB, 

Ascii.CR, 

Ascii.LF, 

aHyphen => NULL; --/* just drop CR */ 

ENDCASE => 

{ 

XStrlng.AppendChar[ 
to: Qpara, 
c: map[Asc11.SP], 
extra: paraLen]; 

}; 

}: 

--/* CR Is skipped If we came from endPara */ 
state <- nextState; 

}: 

Ascii.LF => 

{ 

Flu$hSTC[]; 

IF last # Ascii.CR AND nextState # endPara THEN 

c 

--/* append newline */ 

XString.AppendChar[ 
to: Qpara, 

c: XCharSetO.Make[newLine], 
extra: paraLen]; 

}; 

--/* LF 1$ skipped if we came from endPara */ 

--/* or if last = CR */ 
state «- nextState: 

>5 

Ascii.TAB => 

{ 

--/* tab */ 

FlushSTCC]; 

XStrlng.AppendChar[to: Qpara. c: map[c], extra: paraLen]; 
state <- nextState; 

}i 

Ascii.FF => 

{ 

--/* flush page */ 

FlushSTC[]; 

FlushText[av. Qpara]; 

FlushTelCode$[]; 

DocInterchangeDefs.AppendPageBreak[ 
to: av.doc. 

fontProps: Qav.fontProps]; 
state «- nextState: 
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}: 

Asc11 .NUL -> 

{ 

—/* skip */ 
state «■ nextState; 

}S 

ENDCASE *> 

{ 

FIushSTC[]; 

FOR i: CARDINAL IN [0..unknown.length) DO 

XStrlng.AppendChar[to: @para, c: map[unknown[i]], extra: paraLen]; 
ENDLOOP; 

state + nextState; 

}: 

last «* c; . 

« 

* XStrlng.CharacterLength is an expensive operation. 

* We make the observation that 

* ByteLength >= CharacterLength ALWAYS. Therefore 

* use faster ByteLength to determine if CharacterLength should 

* be called 

» 

IF XStrlng.ByteLength[XString.ReaderFromWr1ter[@para]] > maxPara THEN 

c 

IF XStrlng,CharacterLength[XString,ReaderFromWriter[@para]] > maxPara 
AND nextState # endPara THEN 
state *■ maxExceeded; 

}: 

}: ' 

ignoreTrailIng => 

c 

--/* get next char If other than first entry */ 

IF blanksStart # n THEN 

{ 

last «• c; 

c <- LOOPHOLE[blk[n], CHAR]; 

}; 

SELECT c FROM 

Ascii.SP, Ascii,TAB => 

{ 

state «* IgnoreTrail Ing; 
n «- n + 1; 

blankCount «- blankCount + 1; 

}; 

eopo => 

c 

--/* end found, so skip all trailing blanks */ 
state *■ endPara; 

}: 

Asci 1 .CR => 

c 

—/* NOTE: this arm must follow the eopO arm */ 

—/* ASSERT: eopO # Ascii.CR by order of execution */ 

--/* replace CR with space, and skip blanks */ 

XStrlng.AppendChar[ 
to: @para, 
c: tnap[Asci1 .SP], 
extra: paraLen]; 
state *■ entry; 
blankCount «■ 0; 
n *■ n + 1; 

}; 

ENDCASE => 

{ 

IF CheckAbort[av.background] THEN ERROR ABORTED; 

—/* whoops! Not eol, so append */ 

IF lastBlkCount # blkCount THEN 

{ 

—/* blanks straddle blocks */ 

THROUGH [1. .blankCount] DO 
XString.AppendChar[ 
to: Opara, 
c: map[Asc11.SP], 
extra: paraLen]; 

ENDLOOP; 

} 

ELSE 

FOR i: CARDINAL IN [b1anksStart..n) DO 
XStrlng,AppendChar[ 
to; Qpara, 

c: map[LOOPHOLE[blk[1], CHAR]], 
extra: paraLen]; 

ENDLOOP; 
blankCount <- 0; 
state <■ entry; 

}; 

}:■ 

maxExceeded => 

{ 

FlushText[av, ©para]; 

FlushTelCodes[]; 

DocInterchangeDef s.AppendNewParagraph[ 
to: [doc[av.doc]], 
paraProps: @av.paraProps, 
fontProps: @av.fontProps. 
nToAppend: 1]; 
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state *• entry; 

}: 

endPara *> 

{ 

s; LONG STRING *■ av.src.text[paraEndsW1th]; 

IF s = NIL THEN 

{ 

state «- entry; 
nextState *- entry; 
n «■ n + 1; 
flushed «• FALSE; 

GOTO restart; 

}; 

IF eop » 0 THEN 

{ 

last *■ c; 

C <- LOOPHOLE[blk[n], CHAR]; 

}: 


—/* If we are at the end of s, then match! */ 
IF eop >= s.length THEN 
{ 

IF NOT flushed THEN 

--/* flush all text */ 

F1ushText[av, ©para]; 

FlushTelCodes[]; 

DocInterchangeDefs.AppendNewParagraph[ 
to; [doe[av.doc]], 
paraProps: ©av.paraProps, 
fontProps: ©av.fontProps, 
nToAppend: 1]; 

IF flushed THEN 

--/* flush following text */ 

FIushText[av, ©para]; 

eop +- 0; 
state *■ entry; 
nextState «■ entry; 
flushed <- FALSE; 

GOTO restart; 

}; 


—/* c match with end-of-paragraph? */ 

IF s[eop] = c THEN 

{ 

eop «• eop + X; 
n 4- n + 1; 

} 

ELSE 

{ 

--/* false alarm */ 

IF Ignore THEN 

--/* ouch, we Interrupted IgnoreTralling */ 

FOR j: CARDINAL IN [O..eop) DO 

IF s[J] = Ascii.CR THEN GOTO oneCR; 

IF s[j] # Ascii.SP OR s[j] ft Ascii.TAB THEN 
GOTO notWhite; 

REPEAT 

oneCR => 

c 

--/* replace CR with one blank */ 

XStrlng.AppendChar[ 
to; ©para, 
c: map[Asci1.SP], 
extra: paraLen]; 

—/* other blanks Ignored */ 
blankCount «• 0; 

}: 

notWhite => 

( 

—/* flush blankCount characters */ 

IF 1 ast81 kCount ft blkCount THEN 

{ 

--/* blanks straddle blocks */ 

THROUGH [1. .blankCount] DO 
XString.AppendChar[ 
to: ©para, 
c: map[Ascii.SP]. 
extra: paraLen]; 

ENDLOOP; 

} 

ELSE 

FOR 1: CARDINAL IN [blanksStart..blanksStart+blankCount) DO 
XStrlng.AppendChar[ 
to: ©para, 

c; map[LOOPHOLE[blk[i], CHAR]], 
extra: paraLen]; 

ENDLOOP; 
blankCount <- 0; 

): 

FINISHED *> 

{ 

--/* include current chars in blankCount */ 
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blankCount *• blankCount + {MAX[eop,l] - 1); 
state *■ IgnoreTralling; 

}S 

ENDLOOP; 

—/* set up for next state */ 

IF (C * Ascii.SP OR C = Ascii.TAB) 

AND ignore 

AND state # IgnoreTralling THEN 

{ 

state «• IgnoreTrallIng; 
blanksStart *■ n; 
blankCount ♦* 0; 

TastBlkCount <- blkCount; 

} 

ELSE 

{ 

state «- append; 
n '*■ n + 1; 

—/* account for any CRs +/ 

IF last = CR, then kludge handled It */ 

IF last # ASCII.CR THEN 

FOR j: CARDINAL IN [O..eop) DO 

IF s[j] = Ascii.CR THEN GOTO foundCR; 

REPEAT 

foundCR => 

{ 

—/* replace one or more CRs with one blank */ 
XStr1ng.AppendChar[ 
to: @para, 
c: map[Asc11.SP], 
extra: paraLen]; 

}5 

FINISHED => NULL; 

ENDLOOP; 

}: 

eop *■ 0; 

nextState «- entry; 
flushed «- FALSE: 

GOTO restart; 

—/* end of false alarm */ 

}: 


--/* continue looking for eop */ 

IF c > Ascii.CR THEN 

{ 

—/♦ flush preceding text, clear buffer */ 
FlushText[av, Qpara]; 
flushed «• TRUE; 

}: 


—/♦ translate character */ 
state «- append; 
nextState <■ endPara; 

--/ + special look-ahead kludge to make naked CR’s work */ 
IF c =* Ascii.CR 
AND NOT ignore 
AND eop < S.length 
AND n < av.blk.stopIndexPlusOne 
AND s[eop] # LOOPHOLE[blk[n], CHAR] THEN 
{ 

—/* smart white space */ 

SELECT last FROM 
Asci1.SP, 

Ascii.TAB, 

Ascii.CR, 

Asc11.LF, 

aHyphen => NULL; —/* just drop CR */ 

ENDCASE => 

c 

XString.AppendChar[ 
to: Spara, 
c: map[Asc11.SP], 
extra: paraLen]; 

}: 

}: 

EXITS restart => NULL; 

}; 

ENDCASE; 

ENDLOOP; 

—/* clean up */ 

XString.FreeWriterBytes[@para]; 

String.FreeString[s: digits, z: av.z]; 

String.FreeString[s: telCodes, z; av.z]; 


UserAbortsPaginate: DocInterchangeDefs.CheckAbortProc - { 

« = PROCEDURE [clientData: LONG POINTER] RETURNS [abort: BOOL]; 
>> 

data: AVData = clientData; 

abort <■ CheckAbort[data . background !; 

}: 
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Zzlnlt: PROC = { 

pz: UNCOUNTED ZONE = BWSZone.Permanent^]; 
tableName: XStrlng.ReaderBody; 
fh: NSFIle.Handle; 

tableName «■ XString.FromSTRING["PRC.tcTable"L]; 
fh * GetTableFIle[QtableName]; 
prc «■ CreateTab1e[fh]; 

tableName «• XString . FromSTRING[ n ROC.tcTable’ , L] ; 
fh *■ GetTablef11e[@tableName]; 
roc +• CreateTab1e[fh]; 

-”/* these Spaces should not be unmapped while this application is loaded V 
9 * C 

isomap: Space.ScratchMap[(words + Environment.word$PerPage-l) / Environment.wordsPerPage]. 
pz: pz]; 

FOR c: CHARACTER IN CHARACTER DO 

g . 1 somap[c] <- XCharSetO .Make[LOOPHOLE[cj]; 

EMDLOOP: 

g.isomap[VAL[XCharSetO.Make[comma]]] «- XCharSet41Extra.Make[japaneseComma]; -- 42B 

g.1somap[VAL[XCharSetO.Make[per1od]]] <- XCharSet41Extra .Make[ japanesePeriod] ; -- 43B 

g.1somap[VAL[XCharSetO.Make[leftS1ngleQuote]]] «■ XCharSet41Extra.Make[leftJapaneseQuote]; -- 126B 

g.1somap[VAL[XCharSetO.Make[r1ghtS1ngleQuote]]] «■ XCharSet41Extra.Make[rightJapaneseQuote]; -- 130B 

g. 1$omap[VAL[XCharSetO .MakepeftDaubl eQuote]]] <- XCharSet41Extra.Make[leftJapaneseDoubleQuote]; — 127B 

g.isomap[VAL[XCharSetO,Make[rightDoubleQuote]]] «• XCharSet41Extra.Make[rightJapaneseDoubleQuote]; -- 13IB 


« 

g. 1somap[VAL[XCharSetO .Make[opeo6race]]] *■ XCharSet357 .Make[lef tWhlteLentlcularBracket] ; — 72B 

g . 1somap[VAL[XCharSetO .Make[c1oseBrace]]] <- XCharSet357 ,Make[r1ghtWhiteLent1cularBrack,et] ; -- 73B 

g.1somap[VAL[XCharSetO.Make[comma]]] <- XCharSet41Extra.Make[squareComma]; -- 44B 

g.1somap[VAL[XCharSetO.Make[period]]] * XCharSet41Extra.Make[squarePeriod]; — 45B 


GetTableFIle: PROC [tableName: XStrlng.Reader] RETURNS [file: NSFile.Handle] = { 

-- assume folder is In System catalog 

folderName: XString .ReaderBody «■ XStrlng . FromSTRlNG["Transl Iteration Tables”L]; 

ref: NSFile .Reference *■ TRASH; 

ref *■ GetFIle[@fo1derName, tableName]; 

file *■ NSFile.OpenByReference[reference: ref, session: Catalog.beforelogonSesslon]; 

}; 


GetFile: PROC [folderName, fileName: XString.Reader] 

RETURNS [file: NSFile.Reference <- NSFile.nulIReference] = { 
directory: NSFile.Handle * TRASH; 

FileFromName: PROC [value: XString.Reader] = { 

nsName: NSString .String *■ XString .NSStr1ngFromReader[ 
r: value, z: BWSZone.shortlifetlme]; 
handle: NSFile,Handle *■ NSFile.nul lHandle; 

handle * NSFile.F1nd[ 

directory: directory, ^0 

scope: [filter: [matches[attribute: [name[n$Mame]]]]], 
session: Catalog .beforeLogonSession 

1 NSFile.Error => (handle «- NSFile.nullHandle; CONTINUE}]; 

IF handle » NSFile.nullHandle THEN { 

file «- NSFi 1 e.GetReference[f 11 e: handle, session: Catalog.beforeLogonSession]; 
NSFile.Close[flie: handle, session: Catalog.beforeLogonSession]}; 

NSString.FreeString[z: BWSZone.shortLIfetime, s: nsName]; 


■ft^e 4 


directory «- Catalog.GetF11e[name: folderName, readonly: TRUE, session: Catalog.beforeLogonSession]; 
FileFromName[fileName]; 

NSFile.Close[file: directory, session: Catalog.beforeLogonSession]; 


CreateTable: PROC [table: NSFile.Handle] 

RETURNS [tct: TelegraphCodeTable] { 

count: CARDINAL = ((TelegraphCode.LAST+l)+(Environment.wordsPerPage-1))/Environment.wordsPerPage: 
tct «- NSSegment.Map [ 

origin: [file: table, base: 0, count: count], 

SwapUnits: [uniform[l]], 

session: Catalog.beforeLogonSession].pointer; 

}: 


—/ + main line code */ 
Zzlnit[]; 


END... 

LOG 

16-Mar-87 14:08:16 - Caro - Created 

26 Jun-87 11:21:47 - Caro - Added error catcher in ConvertProc over CreateCommon, 
Caught NSFile.Error in Logoff 
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29-Jun-87 13:13:00 - Caro - Added 11 neHtlnPo 1 nt's, AFTER setting 
10-,lul-87 10:55:05 - Caro - Added aHyphen testing for smart spacing 
19-Aug-87 11:01:32 - Caro - Fixed AR 13535 by updating oldlnstance window 
16-5ep-87 13:48:21 - Caro - Isomap accentFlrst from 241C to 301C 
Isomap lowGraphFIrst from 0 to 241C 
Isomap lowGraphLast from 0 to 277C 
pcmap accentLast from 257C to 245C 
pcmap hIGraphFirst from 260C to 246C 

12-Feb-88 12:58:57 - Shlnsato - In AtoV, made sure eop # NIL before counting CR 

In eop. 


CvSTCToVPImpl.mesa 


ll-Sep-89 12:30:27 PDT 


14 




-- CacheLexiconDef$.mesa 

-- Revised by Walden: 3-Jul-84 12:26:19 

DIRECTORY 

TxtScanDefs USING [ReadonlyWordFIags]. 

XStrlng USING [Reader]; 

CachelexiconDefs: DEFINITIONS - { 

CacheLexIconHandle: TYPE = LONG POINTER TO CachelexiconObject: 

CacheLexiconObject: TYPE; 

-- PROCS 

- added = FALSE if entry already there OR word is empty (offset = limit = 0) 

AddWord: PROC [1: CacheLexIconHandle, word: xstring,Reader, wordFlags: TxtScanOefs.ReadonlyWordF1ags] RETURNS [added; BOOL]; 
Close: PROC [1: CacheLexIconHandle]; 

LookUpWord: PROC [1: CacheLexiconHandle, word: XString.Reader, wordFlags: TxtScanDefs.ReadonlyWordFlags] RETURNS [found: BOOL] 

Open: PROC [nEntriesMax: CARDINAL, z: UNCOUNTED ZONE «■ NIL] RETURNS [CacheLexiconHandle]; 

- NIL if can't open (due to insufficient space/VM) 

}■ 
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CacheLexIconPack.mesa 

Last edit: Walden 3-Jul-84 17:16:14 


-- hash table Iru cache lexicon Implementation 
--- NOTE: should be an object-monitor 

DIRECTORY 

CacheLexiconDefs USING [], 

Environment USING [bytesPerWord, wordsPerPage], 

File USING [nullFile], 

HashTableDefs USING [ 

CreateHashTable, DestroyHashTable, EntryFreeProc, FindEntry, HashTable, KeyObject, RelKey, RelKeyObject, MakeEntry, MakeEntryStatus], 
Inline USING [LongCOPY], 

Space USING [InsuffIcIentSpace, Interval, Map, Unmap], 

TxtScanDefs USING [ReadonlyWordFlags] , 

XStrlng USING [Reader], 

ZoneMgrDefs USING [GetPredefinedZone] ; 

CacheLexIconPack: PROGRAM 

IMPORTS HashTableDefs, Inline, Space, ZoneMgrDefs 
EXPORTS CacheLexiconOefs 
SHARES XStrlng = ( 

OPEN Environment, HashTableDefs, CacheLexiconDefs, XS: XString; 

CacheLexiconHandle: PUBLIC TYPE = LONG POINTER TO CacheLexiconObject: 

CacheLexIconObject: PUBLIC TYPE = MACHINE DEPENDENT RECORD [ 
zone: UNCOUNTED ZONE, 
space: Space.Interval, 
nextFreeOffset: CARDINAL. 
hashTable: HashTable, 
relKeyLastFreed: RelKeyObject 
]: 

Word: TYPE = LONG POINTER TO WordObject; 

WordObject: TYPE - ARRAY[0..nWORDSPerWordMax) OF WORD; 

nBytesPerWordMax: CARDINAL = 20: 

nWORDSPerWordMax: CARDINAL - (nBytesPerWordMax+bytesPerWord-l)/bytesPerWord; — longer words aren't cached 

zSession: UNCOUNTED ZONE - ZoneMgrDefs.GetPredefinedZone[session]; 

Bug: SIGNAL [Bugtype] = CODE: 

Bugtype: TYPE = (impossible, unimplemented); 

AddWord: PUBLIC PROC [1: CacheLexiconHandIe, word: XS,Reader, wordFlags: TxtScanDefs.ReadonlyWordFlags] RETURNS [added: BOOL] = { 
relKey: RelKey; 
status: MakeEntryStatus; 
key: KeyObject = KeyFromWord[word]; 

IF ~ (key.nWords IN (0..SIZEfWordObject]]) THEN 
RETURN [FALSE]; 

--don't cache anything larger than SIZE[WordObject] 

1. re IKeyLastFreed . nWords *■ 0; 

[status: status, relKey: relKey] *• HashTableDefs.MakeEntry[l.hashTable, key]; 

<< if cache is full, MakeEntry will delete the LRU entry, calling FreeEntry, which will set 1.reIKeyLastFreed: we COULD assume that 
relKey* is not changed by hashTable when an entry is recycled [is this a good idea, even though currently true? I think not - how 
to tell reused values from new ones; can't without mods to HashTablePack, and documented guarantee...] >> 

IF status ft ok THEN SIGNAL Bug[impossible]; 

IF 1.relKeyLastFreed.nWords = 0 THEN { --new entry 
relKey .wordOff set «- 1 . nextFreeOffset: 

1. nextFreeOff set *- 1 ,nextFreeOffset+SIZE[WordObject]; 

} 

ELSE -- old entry was "freed" 

reIKey .wordOffset «- 1. relKeyLastFreed .wordOffset; 

relKey.nWords «- key.nWords; 

Iniine.LongCOPY[from: LOOPHOLE[word.bytes], nwords: key.nWords. to: 1.space.poInter+relKey.wordOffset]: 

RETURN [TRUE]; 

}: 


Close: PUBLIC PROC [1: CacheLexiconHandle] = [ 
z: UNCOUNTED ZONE = 1.zone; 

[] *■ Space.Unmap[l .space .pointer] ; 
HashTableDefs.DestroyHashTable[1.hashTable]; 
z .FREE[@1]; 

}: 


LookUpWord: PUBLIC PROC [1: CacheLexiconHandle, word: XStrlng.Reader, wordFlags: TxtScanDefs.ReadonlyWordFlags] RETURNS [found: BOOL] = 

{ 

RE TURN[HashTableDefs.FindEntry[1.hashTable, KeyFromWord[word]].found]: 

}; 

Open: PUBLIC PROC [nEntriesMax: CARDINAL, z: UNCOUNTED ZONE NIL] RETURNS [1; CacheLexiconHandle] - [ 
nPages: CARDINAL = Page$ForWords[nEntrie$Max*SIZE[WordObject]]; 

IF z - NIL THEN z <- zSession; 

1 f- z . NEW[CacheLexiconOb ject] ; 

1. zone «■ z: 

1.space «■ Space.Map[ 

window: [file: File.nullFile, 
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base: TRASH, 
count: nPages], 

class: data ! Space.InsufficientSpace => GOTO abort]; 
l. nextFreeOff set *• 0 ; 

1.hashTable «• HashTableDef s . CreateHashTable[ 
nEntrlesMax: nEntriesMax, 
extraEntriesOK: FALSE, 
relKeyBase: 1.space.pointer, 
clientCtxt: 1. 
type: IruCache, 

entryFreeProc: FreeProc].hashTable; 

IF 1.hashTable = NIL THEN { 

[] *- Space . Unmap[l , space . po inter] ; 

GOTO abort; 

}*. 

EXITS 

abort -> z.FREE[@1]; --sets it to NIL 

}: 

-- PRIVATE PROCS 

FreeProc: HashTableDefs.EntryFreeProc = { 

LOOPHOLE[cl ientCtxt. CacheLex iconllandle]. relKeyLastFreed <- relKeyt; 

}; 

-- nWords = whole # of WORDS to contain word’s bytes 

KeyFromWord: PROP [word: XS.Reader] RETURNS [KeyObject] - INLINE { 

RETURN [[LOOPHOLE[word.bytes], (word.1imit+bytesPerWord-l)/bytesPerWord]]} 

PagesForWords: PROC[words: CARDINAL] RETURNS [pages: CARDINAL] - INLINE { 
RETURN[(words +• wordsPerPage-1)/ wordsPerPage]} : 

LOG 

Walden 2-Jul-84 17:37:04 Created 
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-- File: PARCLexIcon.mesa - last edit: 

-- Walden 21-Apr-87 11:36:15 

-- Copyright (C) 1987 by Xerox Corporation. All rights reserved. 

DIRECTORY 

NSFIle USING [Reference, Type], 

XChar USING [Character], 

XString USING [Reader]; 

PARCLexicon: DEFINITIONS = [ 

--TYPES 

EntryProc: TYPE = PROC [entry: XStri ng .Reader] RETURNS [stop: BOOL «■ FALSE]; 

Handle: TYPE = LONG POINTER TO Object: 

Object: TYPE; 

Case: TYPE = (allLower, capitalized, allUpper, mixed); 

CharArray: TYPE = ARRAY CARDINAL OF XChar.Character: 

CharOescriptor: TYPE = LONG DESCRIPTOR FOR READONLY CharArray: 

— CONSTANTS 

fileType: NSFile.Type = 4474; -- see NSAssignedTypes. 

PROCS 

Close: PROC [handle: Handle]: 

EnumerateEntries: PROCEDURE [handle: Handle, entryProc: EntryProc]; 
GetCodeVersion: PROC RETURNS [CARDINAL]; 

GetNEntries: PROC [handle: Handle] RETURNS [LONG CARDINAL]; 

'entry' should be all lower-case, with ’case’ indicating original state 
-- except for 'mixed' case: entry should have original capitalization 
LookUpEntry; PROC [ 

handle: Handle, entry: CharOescriptor, entryCase: Case, 

1ookUpAsAbbreviation: BOOL] 

RETURNS [found: BOOL, lexiconCase: Case]; 

Open: PROC [fileRef: NSFlie.Reference, zone: UNCOUNTED ZONE, activate: BOOL] 
RETURNS [Handle]; 

-- return some sort of status here??? 

}■ 
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-- File: PARCLexiconlmpl.mesa - last edit: 

-- Mader 29-Dec-87 10:45:17 

Walden 2Q-Jul-87 10:47:42 

Copyright (C) 1987 by Xerox Corporation. All rights reserved. 

DIRECTORY 

Inline USING [BytePair, HighByte, LongCOPY, LowByte. LowHalf], 

InllneExtra USING [SwapWords], 

NSFile USING [Close, Handle, Reference. OpenByReference]. 

NSSegment USING [GetSizelnPages, Map], 

PARCLexicon, 

Space USING [InsufficientSpace, Unmap], 

XChar USING [LowerCase], 

XCharProps USING [IsUpperCase], 

XCharSetO USING [Make], 

XString USING [Character]; 

PARCLex 1 con Imp 1: PROGRAM 

IMPORTS Inline, InlineExtra, NSFile, NSSegment, Space, XChar, XCharProps, XCharSetO 
EXPORTS PARCLexicon = 

BEGIN OPEN PARCLexicon; 

Types 

A1tCharAction: TYPE = RECORD [ 
counterlncrement: INTEGER, 
locatlonlncrement: INTEGER]; 

A1tCharActionTable: TYPE = ARRAY Byte OF A1tCharAction; 

Byte: TYPE = [0..256); 

CodedChar: TYPE = Byte: 

FourBytes: TYPE - MACHINE DEPENDENT RECORD [ 

1owWord(0:0..15): Inline.BytePair. 
highWord(1:0.. 15): Iniine.BytePair]; 

Handle: TYPE - LONG POINTER TO Object; 

Header: TYPE - LONG POINTER TO HeaderRecord; 

HeaderRecord: TYPE = MACHINE DEPENDENT RECORD[ 
bytesInFileDiv256(0): CARDINAL, 
bytesInFileMod256( 1:0 . . 7) : Byte, 
freeFlag( 1:8..8): BOOLEAN. 
hasEowPCounts(1:9..9): BOOLEAN, 
loopFree(l:10..10); BOOLEAN, 
isTransducer(1:11..11): BOOLEAN, 
notMin1m1zed(1:12. .12): BOOLEAN, 
hasEpsilon(1:13..13): BOOLEAN, 
nonDetermin1stic(1:14..14): BOOLEAN, 
startFinalp(i:15..15): BOOLEAN, 
nDictCodes(2:0..7): Byte, 
po1nterEntrySize(2:8. . 16): Byte, 
of f set 1( 3:0 . . 7): Byte, 
offset2(3:8..15): Byte, 
offsetLong(4:0..7): Byte, 
alphabetBase(4:8..15): Byte, 
alphabetTable(5): CARDINAL, 
tablel(6): CARDINAL, 
tab!e2(7): CARDINAL, 

StartStateIndex(8): CARDINAL, 
fSinBase(9): CARDINAL, 
altCounter(10:0.. 7): Byte, 
decrementCounter(10:8..15): Byte, 
changeCounter{11:Q..7): Byte, 
escapeCode(11:8.. 15): Byte, 
idate(12): LONG CARDINAL, 
maxStateCost(14): CARDINAL, 
fIrstFinalChar(15:0,.7): Byte, 
f1rstFinalAltChar(15:8..15): Byte. 
tablelBa$e(16): LONG POINTER, 
totalEowPCount(18); LONG CARDINAL, 
startStateTableBase(20): LONG POINTER, 
firstNSChar(22): CARDINAL, 
alphabetTable$1ze(23:0..7): Byte, 
nStartTables(23:8..15): Byte. 
startStateTableTableBase(24): CARDINAL, 
startStateFirstTransit1onLoc(25): CARDINAL, 
eps11onCode(26;0..7): Byte, 
longestMinimaIPathLength(26:8..15): Byte, 
maxEscapes(27:0..7): Byte, 
longPointerLength(27:8..15): Byte, 
dictCodeToNSTab1eBase(28): CARDINAL. 
tablelCounts(29): CARDINAL, 
table2Counts(30): CARDINAL, 
startStateCountTable8ase(31): CARDINAL, 
startStateZeroCounts(32): CARDINAL, 
freeByte1(33:0..7): Byte, 
freeByte2(33:8..15): Byte, 
tablelEowpCountBase(34): LONG POINTER, 
table2EowpCountBase(36): LONG POINTER]; 

Location: TYPE ■= LONG CARDINAL; 

Locat ionlab le: TYPE = LONG POINTER TO LocatlonSequence, 

LocationSequence; TYPE = RECORD [SEQUENCE COMPUTED CARDINAL OF Location]: 
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LocationTableTable: TYPE = LONG POINTER TO LocationTableSequence; 

LocationTableSequence: TYPE = RECORD [SEQUENCE COMPUTED CARDINAL OF LocationTable]; 


Object: PUBLIC TYPE = RECORD [ 

altCharActIonTable: LONG POINTER TO A1tCharActionTable, 

rangeTable: LONG POINTER TO RangeTable, 

offsetTable: LONG POINTER TO OffsetTable, 

fsm: Table, 

tablet: Table. 

table2: Table, 

wordChars: WordChars, 

nWordChars: CARDINAL, 

maxWordChars: CARDINAL, 

alphabetTable: Table. 

flrstNSChar: XString.Character. 

lastNSChar: XString.Character. 

shift: CodedChar. 

apostrophe: CodedChar, 

startStateTableTable: LocationTableTable. 

secondLevelTable: LocationTableTable, 

nStartStates: CARDINAL. 

nDictCodes: CARDINAL, 

pointer: LONG POINTER, 

file: NSFile.Handle. 

zone: UNCOUNTED ZONE]; 

OffsetTable: TYPE = ARRAY Byte OF Byte; 

Range: TYPE = {offsetl, offset2, offsetLong, alphabetBase, firstFinalChar, altCounter, changeCounter, firstFinalAltChar. 
decrementCounter}; 

RangeTable: TYPE - ARRAY Byte OF Range; 

Table: TYPE = LONG POINTER TO PACKED ARRAY OF Byte: 

TwoByteTabTe: TYPE = LONG POINTER TO ARRAY OF CARDINAL; 

WordChars: TYPE = LONG POINTER TO WordCharSequence; 

WordCharSequence: TYPE = RECORD [SEQUENCE COMPUTED CARDINAL OF CARDINAL]: 
nonExistantCode: CodedChar = 255; 

-- Local Procedures 

AltCharLoc: PROCEDURE [handle: Handle, loc: Location, byte: Byte] 

RETURNS [Location] = INLINE 
BEGIN 

altCharActionTable: LONG POINTER TO AltCharActionTable - handle.altCharActionTable; 
locMod; CARDINAL 5 Iniine.LowHalf [loc] MOD 2; 
base: Table «- handle.fsm + (loc'* loc - locMod)/2; 
locOffset: CARDINAL * locMod + 1; 

SELECT handle.rangeTab1e[byte] FROM 
changeCounter, 
firstFinalAltChar, 
decrementCounter => 

BEGIN -- need to search for alternative 
counter: CARDINAL * l; 
a ItCharAction: AltCharAction * TRASH; 

DO 

altCharAction * altCharActionTable[base[locOffset]]; 

IF altCharAction.1ocationlncrement < 0 THEN 
IF base[locOffset+-3] = 0 THEN 
locOffset * locOffset + 6 
ELSE locOffset * locOffset + 4 

ELSE locOffset * locOffset + altCharAction.1ocationlncrement; 

IF (counter * counter + altCharAction.counterincrement) = 0 THEN EXIT; 

ENDLOOP; 

END; 

ENDCASE; 

-- DecodePointer; 

SELECT handle.rangeTable[byte * base[locOffset]] FROM 

alphabetBase, 

firstFInalChar, 

altCounter, 

changeCounter. 

firstFinalAltChar. 

decrementCounter => -- simple character byte 
RETURN [loc + locOffset]; 

offsetLong => -- long pointer at current Vocation 
RETURN [ 

ThreeByteLocatlon [ 

bytel: handle.OffsetTable[byte], 
byte2: base[locOffset+l], 
byte3: base[locOffset+2] 

] 

]; 

offset2 => -- 2 byte indirect pointer 
RETURN GetPointerTableEntry [ 
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handle.table2, 

TwoBytelndex [bytel: handle.offsetTable[byte], byte2: base[locOffset+1]] 


offsetl => -- single byte indirect table 

RETURN GetPointerTableEntry [handle.tablel. handle.offsetTable[byte]]; 

ENDCASE => RETURN [0]; -- **** can't get here **** 

END: 

BytelsEndOfWord: PROCEDURE [range: Range] RETURNS [BOOLEAN] = INLINE 
BEGIN 
RETURN [ 

SELECT range FROM 
f i rstFinalChar, 
al tCounter, 
firstFinalA1tChar, 
decrenientCounter => TRUE, 

offsetl, 

offset2, 

offsetLong, 

alphabetBase, 

changeCounter => FALSE, 

ENDCASE -> FALSE]: 

END; 

ByteHasAlt: PROCEDURE [range: Range] RETURNS [BOOLEAN] = INLINE 
BEGIN 
RETURN [ 

SELECT range FROM 
altCounter, 
changeCounter, 
f1rstFinalAltChar = > TRUE, 

offsetl, 

offset2. 

offsetLong, 

alphabetBase, 

firstFinaIChar, 

decrenientCounter => FALSE, 

ENDCASE -> FALSE]; 

END: 

ByteHasNext: PROCEDURE [range: Range] RETURNS [BOOLEAN] = INLINE 
BEGIN 
RETURN [ 

SELECT range FROM 
offsetl, 
offset2, 
offsetLong, 
alphabetBase, 
firstFinalChar, 
changeCounter, 
firstFlnalAltChar => TRUE. 

a I tCounter, 

decrenientCounter => FALSE, 

ENDCASE => FALSE]; 

END; 

ComputeWordChars: PROCEDURE [handle: Handle, entry: CharDescriptor, case: Case] 
RETURNS [BOOLEAN] = INLINE 
8EGIN 

length: CARDINAL = entry.LENGTH; 
wordChars: WordChars = handle.wordChars; 
maxWordChars: CARDINAL = handle.maxWordChars; 
shift: CodedChar = handle.shift; 

apostrophe: XString.Character = XCharSetO.Make[apostrophe]: 
wc: CARDINAL <- 0; 
increment: CARDINAL *■ 1; 

IF length > maxWordChars THEN RETURN [FALSE]; 

SELECT case FROM 
capitalized => 

BEGIN 

wordChars[0] *■ shift; 
wc <- l; 

handle.nWordChars «- length + 1; 

END; 

allUpper => 

BEGIN 

wordChars[0] «- shift; 

Iniine.LongCOPY [from: @wordChars[0], to: @wordChars[1] , nwords: length*2 1J; 
wc «- 1; 

increment <- 2; 

END; 

mixed => 

BEGIN 

FOR c: CARDINAL IN [0..length) DO 
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char: XString.Character «• entry[c]; 


IF XCharProps.IsUpperCase [char] THEN 
BEGIN 

wordChars[wc] «* shift: 
wc *■ wc + il; 

char *- XChar.LowerCase [char]: 

END : 

IF (wordChars[wc] «■ NStoCodedChar [handle, char]) = nonExistantCode THEN RETURN [FALSE]: 
wc <- wc * increment; 

ENDLOOP; 

hand! e . nWordChars «- wc: 

RETURN [TRUE]: 

END; 

EMDCASE => NULL: 

FOR c: CARDINAL IN [0..length) DO 
char: XString.Character - entry[c]; 

IF char = apostrophe THEN wc «- wc - (increment - 1): -- point to shift if present 

IF (wordChars[wc] *■ NStoCodedChar [handle, char]) = nonExistantCode THEN RETURN [FALSE]; 

wc *• wc + Increment: 

ENDLOOP; 

hand! e . nWordChars «- wc (increment l);. 

RETURN [TRUE]; 

END; 

OictChar: PROCEDURE [handle: Handle, byte: Byte] 

RETURNS [CodedChar] = INLINE 
BEGIN 

RETURN [handle.offsetTable[byte]]; 

END; 

GetByte: PROCEDURE [table: LONG POINTER, loc: Location] RETURNS [Byte] - INLINE 
BEGIN 

ptr: LONG POINTER TO WORD = table *■ (loc/2); 

RETURN [ 

IF loc MOD 2 = 0 THEN 
In I ine.HighByte [ptrt] 

ELSE Iniine.LowByte [ptrt]]; 

END; 

GetPointerTableEntry: PROCEDURE [table: Table, index: CARDINAL] 

RETURNS [Location] = INLINE 
BEGIN 

RETURN [LOOPHOLE [table, TwoByteTable][Index]]; 

END; 

NextCharLoc: PROCEDURE [handle; Handleiloc: Location] RETURNS [Location] = INLINE 
BEGIN 

base: Table = handle.fsm + (loc/2); 

locOffset: CARDINAL = (Iniine.LowHalf [loc] MOD 2) + 1; 
offsetTable: LONG POINTER TO OffsetTable = handle.offsetTable; 
byte: Byte = base[locOffset]; 

-- DecodePointer: 

SELECT handle,rangeTable[byte] FROM 

alphabetBase, 

firstFinalChar, 

altCounter, 

changeCounter, 

f1rstFinalAltChar, 

decrementCounter => -- simple character byte 
RETURN [1oc +1]: 

offsetLong => -- long pointer at current location 
RETURN ThreeByteLocation [ 
bytel: offsetTable[byte], 
byte2: ba$e[locOff$et+-l], 
byte3: base[locOffset+2]]; 

offset2 => -- 2 byte Indirect pointer 
RETURN GetPointerTableEntry [ 
handle.table2, 

TwoBytelndex [bytel: offsetTable[byte], byte2: base[locOffset+1]]]; 

offset! => -- single byte indirect table 

RETURN GetPointerTableEntry [handle.tablet, offsetTablefbyte]]; 

ENDCASE => RETURN [0]; -- **** can’t get here **** 

END; 

NStoCodedChar: PROCEDURE [handle: Handle, ns; XString.Character] 

RETURNS [CodedChar] = INLINE 
BEGIN 
RETURN [ 

IF ns IN [handle.firstNSChar..handle.1astNSChar] 

THEN handle.alphabetTable[ns - handle.firstNSChar] 

ELSE nonExistantCode]; 

END; 

ThreeByteLocation: PROCEDURE [bytel, byte2. byte3: Byte] RETURNS [Location] = INLINE 
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BEGIN 
RETURN [ 

LOOPHOLE [ 

FourBytes[highWord: [high: 0, low: bytel], lowWord: [high: byte2, low: byte3]] 
1 . 

]; 

END; 

TwoBytelndex: PROCEDURE [bytel, byte2: Byte] RETURNS [CARDINAL] = INLINE 
BEGIN 

RETURN [LOOPHOLE [Iniine.BytePair[high: bytel, low: byte2]]]; 

END; 

-- Public Procedures 

Close: PUBLIC PROCEDURE [handle: Handle] = 

BEGIN 

z: UNCOUNTED ZONE = handle.zone; 

[] «- Space.Unmap [handle.pointer]; 

NSFile.Close [handle.file] ; 
z.FREE [©handle.altCharActionfable]; 
z.FREE [©handle.rangeTable]; 
z.FREE [©handle.offsetTable]; 
z.FREE [©handle.wordChars]; 

FOR c; CARDINAL IN [0..handle.nDictCodes) DO 
z.FREE [©handle.secondLevel Tab 1e[c]]; 

ENDLOOP; 

z . FREE [©handle.secondLevelTable]: 

FOR c: CARDINAL IN [0,,handle.nStartStates) DO 
z.FREE [©handle.startStateTableTable[c]]; 

ENDLOOP; 

z.FREE [©handle,startStateTableTable]: 
z.FREE [©handle]; 

END; 

GetCodeVerslon: PUBLIC PROCEDURE RETURNS [CARDINAL] - 
BEGIN RETURN [l] END; 

GetNEntries: PUBLIC PROCEDURE [handle: Handle] RETURNS [LONG CARDINAL] = 

BEGIN 

header: Header = handle.pointer; 

RETURN [IniineExtra.SwapWords [header.totalEowPCount]] ; 

END; 

EnumerateEntries: PUBLIC PROCEDURE [handle: Handle, entryProc: EntryProc] = 

BEGIN END; 


LookUpEntry: PUBLIC PROCEDURE [ 
handle: Handle, 
entry: CharDescriptor, 
entryCase: Case, 
lookUpAsAbbreviation: BOOLEAN] 

RETURNS [found: BOOLEAN, lexiconCase: Case] = 

BEGIN 

IF ComputeWordChars [handle, entry, entryCase] THEN 
BEGIN 

-- try in the main dictionary 
SELECT entryCase FROM 
allUpper => 

BEGIN 

-- try as lower case 

IF Lookup [handle: handle, firstChar: l, skipShift: TRUE] 
THEN RETURN [TRUE, all Lower]; 


-- try capitalized 

IF Lookup [handle: handle. firstChar: 0 . skipShift: TRUE] 

THEN RETURN [TRUE, capitalized]: 

END; 

capitalized -> 

IF Lookup [handle: handle, firstChar: l] THEN RETURN [TRUE, allLower]; 
LNDCASE: 


IF Lookup [handle: handle] THEN RETURN [TRUE, entryCase]; 

IF lookUpAsAbbreviation THEN 
BEGIN 

SELECT entryCase FROM 
allUpper => 

BEGIN 

-- try as lower case 

IF Lookup [handle: handle, firstChar: 1, skipShift: TRUE, startState: 1] 
THEN RETURN [TRUE, allLower]; 

-- try capitalized 

IF Lookup [handle: handle, firstChar: 0, skipShift: TRUE, startState: l] 
THEN RETURN [TRUE, capitalized]; 

END; 

capitalized => 

IF Lookup [handle: handle. firstChar: l, startState: l] 


PARCLexiconlmpl.mesa 


29-Dec-87 10:45:17 PST 



THEN RETURN [TRUE, all Lower]; 


ENDCASE;- 

IF Lookup [handle: handle, startState: l] THEN RETURN [TRUE, entryCase]; 

END; 

END; 

RETURN [FALSE, all Lower]; 

END; 

Lookup: PROCEDURE [ 
handle: Handle, 
firstChar: CARDINAL «■ 0, 

StartState: CARDINAL «- 0, 
sklpShlft: BOOLEAN <- FALSE] 

RETURNS [found: BOOLEAN] = 

BEGIN 

rangeTable: LONG POINTER TO RangeTable = handle.rangeTable; 
wordChars: WordChars = handle.wordChars; 
wchar: CodedChar «■ wordChars[f i rstChar]; 
shift: CodedChar = handle.shift; 
wc: CARDINAL *■ firstChar + 1; 
nWordChars: CARDINAL = handle.nWordChars: 
loc; Location «- TRASH; 
fsm: Table = handle,fsm; 
range: Range «- TRASH; 
byte: Byte «■ TRASH; 

NextWordChar: PROCEDURE RETURNS [wchar: CodedChar] = INLINE 
BEGIN 
DO 

wchar <- wordChars[wc]; 
wc *■ wc i- 1; 

IF -skipShift OR wchar » shift THEN RETURN; 

ENDLOOP; 

END; 

SELECT TRUE FROM 

startState = 0 AND wc < nWordChars => 

BEGIN 

sit; LocationTable = handle.secondLeve!Table[wchar]; 

wchar ** NextWordChar[] ; 
loc *■ slt[wchar]; 

END; 

StartState >= handle.nStartStates => RETURN [FALSE]: 

ENDCASE => loc «- handle . startStateTableTable[startState][wchar]; 

IF loc = 0 THEN RETURN [FALSE]; 

DO 

range «• rangeTable[byte «- GetByte [fsm, loc]]; 

SELECT TRUE FROM 

wchar = DictChar [handle, byte] *> 

BEGIN 

SELECT TRUE FROM 
wc > = nWordChars ~> 

RETURN [BytelsEndOfWord [range]]; 

ByteHasNext [range] => 

BEGIN 

wchar «- NextWordChar []; 
loc +■ NextCharLoc [handle, loc]; 

END; 

ENDCASE => 

RETURN [FALSE]; 

END; 

ByteHasAlt [range] => 

loc «- AltCharLoc [handle, loc, byte]; 

ENDCASE => 

RETURN [FALSE]; 

ENDLOOP; 

END; 

Open; PUBLIC PROCEDURE [ 
fileRef: NSFile.Reference, 
zone: UNCOUNTED ZONE, 

activate: BOOLEAN] RETURNS [handle: Handle] = 

BEGIN 

file: NSF i le. Handle *■ NSFile.OpenByReference [fileRef]; 

altCharActionTable: LONG POINTER TO A1tCharActionTable «- zone.NEW [A1tCharActionTable] 
rangeTable; LONG POINTER TO RangeTable «- zone.NEW [RangeTable]; 
offsetTable: LONG POINTER TO OffsetTable «■ zone.NEW [OffsetTable]; 
header; Header *■ TRASH; 

Offset!: CARDINAL «■ TRASH; 
offset2: CARDINAL *■ TRASH; 
offsetLong: CARDINAL <- TRASH; 
alphabetBase: CARDINAL <- TRASH; 
f 1 rstFinalChar: CARDINAL TRASH; 
altCounter: CARDINAL *- TRASH; 
changeCounter: CARDINAL <- TRASH: 
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firstFinalAltChar: CARDINAL <- TRASH; 
decrementCounter: CARDINAL «- TRASH; 
nOictCodes: CARDINAL TRASH; 
nStartStates: CARDINAL «■ TRASH; 
startStateTableOffsets: TwoByteTable «- TRASH; 
sstt: LocationTableTable «■ TRASH; 
sit: LocationTableTable *■ TRASH; 
fsm: Table *- TRASH; 

handle *■ zone.NEW [Object]; 
handle.zone <■ zone; 
handle.file «■ file; 

handl e. al tCharActionTable «- al tCharActlonTable : 
handle. rangeTable *- rangeTable; 
handle.offsetTable <- offsetTable; 

header handle .pointer * NSSegment.Map [ 

origin: [file: file, base: 0, count: NSSegment.GetSizelnPages [file]], 
swapUnits: [unitary[]] 

•Space.InsuffIcientSpace => { 
zone.FREE[@handle]; -- return value - NIL 

zone.FREE[@offsetTable]; 
zone.FREE[@rangeTab1e]r 
zone.FREE[@altCharActionTable] ; 

NSF11e.Close[file]; 

GOTO OutOfVM}] .pointer.; 

handle.fsm «- handle.pointer +■ header. fsmBase/2; 

handle.alphabetTable <- handle.pointer + header, alphabetTable/2 ; 

handle. tablel «■ handle.pointer + header. tableI/2; 

handle . tabl e2 «■ handle . poi nter + header. table2/2; 

offsetl *- header. of f set l; 

offset2 «- header.offset2: 

offsetLong «- header.offsetLong; 

alphabetBase «- header.alphabetBase : 

firstFinalChar «■ header. f i rstF inalChar; 

altCounter «■ header.altCounter; 

changeCounter «■ header.changeCounter; 

f i rstFina 1 Al tChar *- header. fi rstFi nalAl tChar; 

decrementCounter *- header .decrementCounter; 

handle.firstNSChar «- header. f i rstNSChar: 

handle. 1 astNSChar *- header.f irstNSChar ^ header.alphabetTab leSize 1; 

handle.shift «- NStoCodedChar [handle, XCharSetO, Make [grave]]; 

handle.apostrophe *- NStoCodedChar [handle, XCharSetO.Make [apostrophe]]; 

handle. nWordChars «■ 0; 

handle.maxWordChars *■ header.longestMinimalPathLength; 

handle.wordChars «• zone.NEW [WordCharSequence[handle.maxWordChars*2]]; -- *2 for shifts 

FOR b: Byte IN [offsetl.,offset2) DO 
rangeTable[b] «- offsetl; 
offsetTable[b] *■ b - offsetl; 

altCharActionTable[b] «- [counterincrement: -1, 1 ocationlncrement; 1]; 

ENDLOOP; 

FOR b: Byte IN [offset2..offsetLong) DO 
range Tab I e[b] *- offset2; 
offsetTable[b] *■ b - offset2; 

altCharActionTable[b] «• [counterincrement: -1, locationlncrement: 2]; 

ENDLOOP; 

IE header.hasEowPCounts THEN 
FOR b: Byte IN [offsetLong..a 1phabetBase) DO 
rangeTable[b] *• offsetLong; 
offsetTable[b] *■ b - offsetLong; 

altCharActionTable[b] *■ [counterincrement: 1, locationlncrement: -1]; 

ENDLOOP 

ELSE 

FOR b: Byte IN [offsetLong..alphabetBase) DO 
rangeTable[b] «- offsetLong; 
offsetTable[b] *■ b - offsetLong; 

altCharActionTable[b] «- [counterincrement; -1. locationlncrement; 3]; 

ENDLOOP; 

FOR b: Byte IN [alphabetBase..firstFinalChar) DO 
rangeTable[b] +■ alphabetBase; 
offsetTable[b] <- b - alphabetBase; 

altCharActionfable[b] «- [counterincrement: 0, locationlncrement; 1]; 

ENDLOOP; 

FOR b: Byte IN [firstFinalChar,.altCounter) DO 
rangeTable[b] <- firstFinalChar; 

OffsctTab le[b] «- b - f irstFinalChar; 

al tCharActionTable[b] «■ [counterincrement: 0, locationlncrement: 1]; 

ENDLOOP; 

FOR b; Byte IN [altCounter..changeCounter) DO 
rangeTable[b] *■ altCounter; 
offsetTable[b] «* b - altCounter; 

altCharActionTable[b] «- [counterincrement: 0, locationlncrement: 1]; 

ENDLOOP; 

FOR b: Byte IN [changeCounter..firstFinalAltChar) DO 
rangeTable[b] «* changeCounter; 
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offsetTable[b] *■ b - changeCounter; 

altCharActionTable[b] «• [counterincrement: +1, locatlonlncrement: l]; 

ENDLOQP; 

FOR b: Byte IN [flrstFinalAltChar..decrementCounter) DO 
rangeTable[b] «■ firstFinalAltChar: 
offsetTable[b] <- b - firstFinalAltChar; 

aItCharActionTable[b] *■ [counterincrement: +1, locationlncrement: 1]; 

ENDLOOP; 

FOR b: Byte IN [decrementCounter..266) DO 
rangeTable[b] «- decrementCounter; 
offsetTable[b] «- b decrementCounter; 

altCharActionTable[b] <- [counterincrement: -1, locationlncrement: 1]; 

ENDLOOP; 

handle.nStartStates <- nStartStates *• header.nStartTables ; 
handle.nDIctCodes *• nDictCodes «- header . nDictCodes : 

sstt «■ handle.startStateTableTable «- zone.NEW [LocationTab1eSequence[nStartState$]]; 
startStateTab leOff sets <- handle.pointer +■ header. startStateTableTableBase/2; 

-- Pre-compute the starting Location's for each character in each start state. 

FOR ss: CARDINAL IN [0..nStartStates) DO 

sst: LocationTable «- zone.NEW [LocationSequence[nDictCodes]]; 
table: Table «■ handle .pointer + startStateTableOffsets[ss]/2; 
offset: CARDINAL «- 0; 

sstt[ss] <- sst; 

FOR b: Byte IN [0..nDictCodes) DO 
sst[b] *■ ThreeBytel.ocation [ 
bytel: table[offset], 
byte2: table[offset + 1], 
byte3: table[offset *• 2]]; 
offset *■ offset + 3; 

ENDLOOP; 

ENDLOOP; 

Pre-compute the second level starting Location’s for start state 0 
- Using this table we can quicly get to the Location for the second character 

handle. secondLevelTable *■ sit <- zone.NEW [LocationTableSequence [nDictCodes]]; 
fsm «■ handle . fsm: 

FOR wcl: CodedChar IN [0..nDictCodes) DO 

It: LocationTable *■ zone,NEW [LocationSequence [nDictCodes]]; 
loc: Location *- sstt[0][wcl]: -- FirstCharLoc [wcl] 
wc2: CodedChar *- TRASH; 
byte: Byte *- TRASH; 

slt[wcl] <- It; 

loc *- NextCharLoc [handle, loc]; 

FOR c: CodedChar IN [0..nDictCodes) DO 
It [c] <- 0; 

ENDLOOP; 

DO 

wc2 «- DictChar [handle, byte *■ GetByte [fsm, loc]]; 
lt[wc2] «■ loc; 

IF ~ByteHa$Alt[rangeTable[byte]] THEN EXIT; 
loc AltCharLoc [handle, loc, byte]; 

ENDLOOP; 

ENDLOOP; 


EXITS OutOfVM => NULL; 
END; -- Open 


END. . . 
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catch to Space.InsuffIcientSpace to NSSegment.Map call 

AltCharLoc must do byte base[locOffset] even if it doesn't go around the loop. 

Get word count from header.totalEowPCount. 

Do IniIneExtra.SwapWords on above. 

Lookup: skip shift if followed by apostrophe; add NStoCodedChar and use it in ComputeWordChars 
ComputeWordChars: don't shift apostrophe; Lookup: always advance wc by 1 after apostrophe. 
Lookup: replace increment with skipShift BOOLEAN. 
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-- File: PARCLexiconPluginlmpl.mesa - last edit: 
-- Walden 21-Apr-87 12:54:34 


-- Copyright (C) 1987 fay Xerox Corporation. All rights reserved. 

DIRECTORY 

temp: 

BWSZone USING [semipermanent], 

CacheLexIconDefs USING [AddWord, CacheLexiconHandle, Close, LookUpWord, Open], 

LexiconDefs USING [ 

CloseProc, CreateProc, EnumerateProc, 

GetNWordsProc, IsCurrentProc, LexiconHandle. 

LexiconObject, LexiconType, LookUpWordProc, OpenProc, SetOps], 

NSFIle USING [GetReference], 

PARCLexicon USING [ 

Case. Close, EnumerateEntries, GetCodeVersion, GetNEntries, 

Handle, LookUpEntry, Open], 

Runtime USING [NarrowFault], 

XChar USING [Character], 

XString USING [Map, MapCharProc]; 

PARCLexiconPluginlmpl: PROGRAM 

IMPORTS BWSZone, CacheLexiconDefs, LexiconDefs, NSFile, PARCLexicon. Runtime. XString 
SHARES LexiconDefs = { 

Handle: TYPE = LONG POINTER TO Object: 

Object: TYPE = MACHINE DEPENDENT RECORD [ 
lexicon: LexiconDefs. Lex iconObject., 
zone: UNCOUNTED ZONE. 

cache: CacheLexiconDefs.CacheLexiconHandle, 
parcLexiconHandIe: PARCLexicon.Handle]; 

CONSTANTS 

parcLexicon: LexiconDefs.LexiconType - LexiconDefs.LexiconType.firstSpare: 

- VARIABLES 

- PROCS 

Close: LexiconDefs.CloseProc 

<<PROC [lexicon: LexiconHandle]>> * { 
handle: Handle *■ Narrow[lexicon]; 
zone: UNCOUNTED ZONE = handle.zone; 

CacheLexiconDefs.Close[handle.cache]; 

PARCLex icon.Close[handle.parcLexiconHandle]; 
zone.FREE[©hand Ie]: 

}; --Close 

EnumerateWords: LexiconDefs.EnumerateProc 

<<PROC [lexicon: LexiconHandle, wordProc: WordProc]>> = { 
handle: Handle = Narrow[lexicon]; 

PARCLexicon.EnumerateEntries[handle.parcLexiconHand1e, wordProc]: 

}: 

GetNWords: LexiconDefs.GetNWordsProc 

<<PRQC [lexicon: LexiconHandle] RETURNS [nWordsCur, nWordsMax: LONG CARDINAL}>> 

= c 

handle: Handle - Narrow[lexicon]; 

nWordsCur <- nWordsMax «- PARCLexicon ,GetNEntries[handl e , parcLex iconHandl ej; 

}: --GetNWords 

IsCurrent: LexiconDefs.IsCurrentProc = [RETURN[ 
fileAttrs.type = parcLexicon AND 

fileAttrs.vers ion = PARCLexicon.GetCodeVersion[]]}: 

LookUpWord: LexiconDefs.LookUpWordProc = { 

<<PR0C [lexicon: LexiconHandle, word: XS.Reader, flags: TxtScanDefs.ReadonlyWordFlags] RETURNS [found: BOOL]>> 
handle: Handle = Narrow[lex1con]; 
nCharsMax: CARDINAL = 50: 
i : CARDINAL «■ 0; 

charArray: ARRAY [0..nCharsMax } OF XChar.Character: 
useCache: BOOL = -forCorrections; 
lexiconCase: PARCLexicon.Case; 

AddChar: XString.MapCharProc = [ 
charArray[ I ] *■ c; 
i *■ i +1; 

RETURN [stop: (i = nCharsMax)]: 

u 


-- this guy knows that the cache lexicon only contains lower-case, or equivalent, words 

IF useCache AND (wordFlags.case ft mixedLowerUpper) AND CacheLex iconDefs. LookUpWord[ 
handle.cache, word, wordFlags].found THEN RETURN [TRUE]; 

[] «- XString . Map[word . AddChar]; 

[found, lexiconCase] *■ PARCLexicon . LookUpEntry[ 

handle: handle.parcLexiconHandle, entry: DESCRIPTOR[charArray.BASE, i], 
entryCase: (SELECT wordFlags.case FROM 
all Lower => all Lower, 
firstCharUpperOnly ■> capitalized, 
mixedLowerUpper => mixed, 

ENDCASE -•> allUpper), 
lookUpAsAbbreviation: useCache]; 

IF found THEN { 

IF useCache AND (lexiconCase = allLower) THEN - only add lower case words to cache 
[] *■ CacheLexiconDefs .AddWord [handle .cache, word, wordFlags]; 
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RETURN [TRUE]; 

} 

ELSE RETURN [FALSE]; 

}; -- LookUpWord 

Open: LexIconDefs.OpenProc 

<<PROC [lexiconFile: NSFi le .Handle. readonly: BOOL, z: UNCOUNTED ZONE *■ NIL, 
session: NSFile.Session] 

RETURNS [lexicon: LexiconHandle]>> 

= { 

handle: Handle; 

parcLexiconHandle: PARCLexicon.Handle; 

IF z 3 NIL THEN z «- BWSZone. semipermanent; 
parcLexiconHandle «- PARCLex icon ,Open[ 

fileRef: NSFile.GetReference[lexiconFile, session], zone: z, activate: TRUE]; 

IF parcLexiconHandle = NIL THEN RETURN [NIL]: 

handle «■ z.NEW[Object «- [ 
lexicon: [ 

type: parcLexicon. zone: z. add: NIL. close: Close, delete: NIL. 
enumerate: EnumerateWords, getNWords: GetNWords. lookup: LookUpWord], 
zone: z, 

cache: CacheLexiconDefs.Open [nEntriesMax: 500. z: z], 
parcLexiconHandle: parcLexiconHandle]]: 

RETURN [Widen[handle]]: 

}: --Open 

-- PRIVATE PROCS 

Narrow: PROC [1: Lex iconDef s . Lex iconllandl e] RETURNS [Handle] - INLINE { 

IF 1.type # parcLexicon THEN ERROR Runtime.NarrowFault; 

RETURN[L00PH0LE[1]]}; 

Widen: PROC [handle: Handle] RETURNS [LexiconDefs.LexiconHandle] - INLINE [ 

RETURN[@hand 1e.lexicon]}; 

MAINLINE 

LexiconDef s.SetOps[ 

type: parcLexicon, ops: [create: NIL, isCurrent: IsCurrent, open: Open]]; 


LOG 

2-Apr-87 9:07:25 - Walden - Created 
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File: Spel1IngCheckerDefs.mesa - last edit: 


Walden.ES 
Maybury.ES 
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DIRECTORY 

AreaDefs USING [Rs], 

DocumentDefs USING [Handle], 

FormWindow USING [TextHintsProc], 

LexiconDefs USING [LexiconHandle, Lexicons], 

NSAssignedTypes USING [firstStarType], 

NSFile USING [Handle, nullHandle, nullSession, Reference. Session, Type], 

RgnDefs USING [Sc], 

SchemaDefs USING [Lschema, IschemaNilJ, 

StarWindowShel1 USING [Handle, nullHandle], 

System USING [GreenwichMeanTinie], 

ToolUtilItlesOefs USING [toolPstype], 

TxtDefs USING [Block], 

TxtScanDefs USING [EnumScope, ReadonlyWordFlags. WordFlagsObject, WordScanCtxtObject], 

Window USING [Handle], 

XString USING [nulIReaderBody, nul1WriterBody. Reader, ReaderBody. WriterBody]; 

SpellingCheckerDefs: DEFINITIONS = { 

OPEN RgnDefs. SchemaDefs. TxtDefs, TxtScanDefs: 

AddOrDelete: TYPE = [add, delete}; 

CheckCtxt: TYPE = LONG POINTER TO CheckCtxtObject: 

CheckCtxtObject: TYPE - REC0RD[ --global context 
zone: UNCOUNTED ZONE. 

fw: Window.Handle t NIL. -- is the following the same? I think it is. 

sws : StarWindowShel 1 .Handle *■ StarWindowShel 1 .nul IHandle , 

windowOpen: BOOLEAN <- FALSE, 

doc: DocumeotDefs .Handle «■ NIL, 

body: Lschema «- IschemaNil, 

nWor-ds: CARDINAL «- 0. 

scratchBlock: TxtDefs.B1ock, 

-- miStartContinue: MiSchemaDef $ . Mihandle *■ TRASH, 
continueShowing: BOOL <- FALSE, 

scScanCtxtObject: SCScanCtxtObject <- TRASH. 

--must be initialized to be long enough to hold longest desireable list of alternatives 
alternatives: XString .WriterBody «- XStr ing. nul 1 Wri terBody, 
rsAlternatives: AreaDefs.Rs «■ [0, 0], 

cGenerateAlternatives: CONDITION *• [0], 

cDoneGeneratingAl ternatives : CONDITION *■ [0], 

generatingAlternatives, 

abortAl ternatives : BOOL «- FALSE, 

pAlternativesGeneration: PROCESS «- TRASH. 

--a 1ternativesWord must be initialized to be long enough to hold longest word, plus 3 bytes for normalization 
al ternat ivesWord: XString. WriterBody <- XStri ng. nullWr iter8ody, -- in normalized form 

al ternat ivesWordFlags : WordFlagsOb ject *■ TRASH, 
alternatlvesLookUp: LexiconDefs .Lexicons <- NIL, 

correct ionLexicon: NSFi 1 e .Handle «- TRASH, --for autocorrect 
correctionList: LexiconDefs.LexiconHandle *■ TRASH, -for autocorrect 
lastCorrectlonValue: XString .ReaderBody *- XString ,nul IReaderBody, 
ignoreLexicon: NSFile.Handle *• TRASH, 
ignoreLlst: LexiconDefs .LexiconHandle <- TRASH. 

userLexlconCtnr: NSFile , Handle «• NSFI le . nu 11 Hand le. 
lexicons: LptLexiconDataList «■ NIL, 

1 istCreationTIme: System.GreenwichMeanTime «- [0], 
lastUserSess ion: NSFi 1 e . Session «- NSFi le. nu l ISesslon , 
ref reshActiveLists, 
inval IdAltLIst: BOOL *■ TRUE, 

nLookUp, nEdlt: CARDINAL <- 0. 
lexiconsLookUp, 

lexiconsEdi t: LptLex iconList *■ NIL 

1 ; 

LexiconData: TYPE ~ RECORD [ 
ref: NSFile.Reference, 
file: NSFile.Handle, 
name: XString.Reader, 
lexicon: LexiconDefs.LexiconHandle, 
nWords: LONG CARDINAL, 
systemLex, 
edit, 

lookup: BOOL 

]; 

LexIconDataList: TYPE - RECORD [ 

seq: SEQUENCE nLexicons: CARDINAL OF LexiconDat.a]; 

currentVersion: CARDINAL = 1; 

DisplayAttrsType: TYPE = [lexicon, wn}; 

DIsplayAttrs: TYPE - MACHINE DEPENDENT RECORD[ 
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version(O): CARDINAL «• currentVersion, 
var(L): SELECT type(1): D1splayAttrsType FROM 
lexicon => [ 

selectedForLookUp (2: 15..15): BOOL, 
selectedForEdit (2: 14..14): BOOL, 

unused (2:0.. 13): PACKED ARRAY [0..13] OF [0..1] «- ALL[0]], 
wn => [ 

scWn(2): RgnOefs.Sc, 
rs8ody(4): AreaDefs.Rs, 
scope(6): TxtScanDefs.EnumScope, 
autoCorrect(7 : 15..15): BOOL, 

Inc ludeAnchoredFrantes( 7 : 14..14): BOOL, 
sysLexSelectedForLookUp(7: 13...13): BOOL, 

unused (7: 0..12): PACKED ARRAY [0..12] OF [0..1] - ALL[0]], 

ENDCASE 

]: 

Items: TYPE = {scope, chcckFrames, autoCorrect, misspelling, correction}: 

LexiconDisplayAttrs: TYPE = LONG POINTER TO Disp1ayAttrs.1exlcon: 

WnDisplayAttrs: TYPE = LONG POINTER TO DisplayAttrs.wn; 

LexiconLlst: TYPE = RECORD [ 

seq: SEQUENCE COMPUTED CARDINAL OF LexiconDefs.LexiconHandle]; 

LptLextconData: TYPE = LONG POINTER TO LexiconData; 

Lpt.LexiconDataList: TYPE = LONG POINTER TO Lex i conDataL i $ t; 

LptLexiconList: TYPE - LONG POINTER TO LexiconList; 

SCScanCtxt: TYPE = LONG POINTER TO SCScanCtxtObject; 

SCScanCtxtObject: TYPE = MACHINE DEPENDENT RECORD [ 
wordScanCtxtObject(0): TxtScanDefs.WordScanCtxtObject, 

--scScanCtxt data 

norma IizedWord(28): XString.WriterBody, 
nProcessed( 37 ) : CARDINAL <- 0. 
autoCorrect( 38 ) : BOOL <- FALSE 

CONSTANTS 

- + HACK FIX. NEED TO HAVE A UNIQUE StarAttr ibuteType. 

disp IayAttrType: NSFile.Fype - NSAssignedTypes.firstStarType + 39; 
nBytesLongestWord: CARDINAL - 40; --for scanning and alternatives source word 
nBytesLongestCorrection: CARDINAL = 100; --for Correction text when used with Correct cmd 

-- range choice parm constants 
allText: CARDINAL = 0; 
remainingText: CARDINAL = 1; 

SelectedText: CARDINAL - 2; 

checkCtxt: CheckCtxt; 

fIrstLexiconPstype: CARDINAL = ToolUtilitiesDefs.toolPstype+1; 

PROCEDURES 

AddMenuCommands: PROC [sws: StarWindowShel 1 .Handle, iteniData: LONG UNSPECIFIED]; 

AddOrDeleteWords: PROC [addOrDelete: AddOrDelete]; 

ChoiceFromScope: PROC [scope: TxtScanDefs.EnumScope] RETURNS [choice: CARDINAL] = INLINE { 

-- if choice parm arrangement changes, this won’t be valid 
RETURN [(SELECT scope FROM 
all => allText, 
remainder => remainingText, 
selection => selectedText. 

ENDCASE => allText)]]; 

ClearHostDocCs: PROC; 

ClearFdbkParms: PROC; 

CloseUtil: PROC [fw: Window.Handle, itemData: LONG UNSPECIFIED]; 

CloseLexicons: PROC RETURNS [sysLexSelectedForLookUp: BOOL]; 

Cont inueChecking : PROC [lookup: LexiconDefs.LexiconsJ; 

CreateA1 ternativesProcess: PROC RETURNS [PROCESS]; 

CreateLexiconLists: PROC [systemLexSeleetedForLookUp: BOOL, c: CheckCtxt]; 

CreatePairList: PROC [nPairsMax: CARDINAL, z: UNCOUNTED ZONE] RETURNS [LexIconDefs.LexiconHahdle]; 

AddPopupMenu: PUBLIC PROC [shell: StarWindowShel1.Handle]; 

DestroyAlternatlvesProcess: PROC [p; PROCESS]; 

DestroyPairLiSt: PROC [list; LexiconDefs.LexiconHandle]; 

GetActiveLexicons; PROC RETURNS [lookup, edit: LexiconDefs.Lexicons]; 

-- word should be in lexicon "normalized" form 

LookUpInPairList: PROC [list: LexiconDefs.LexiconHandle, word: XString.Reader, wordFlags: IxtScanDefs.ReadonlyWordFlags] RETURNS 
[found: BOOL, associate: XString.ReaderBody, associateFlags: TxtScanDefs.ReadonlyWordFlags]; 

MakeDoc: PROC [lexicon: LexiconDefs.LexiconHandle, name: XString.Reader] RETURNS [ok: BOOL]; 

--if none, RETURNS [nullHandle, System.gmtEpoch. default attrs]: 


Spe11ingCheckerDef s.mesa 


26-Mar -87 16:22:16 PST 


? 



OpenUserLexiconCtnr: PROC RETURNS [file: NSFile.Handle, lastModifledOn: System.GreenwichMeanTime, dispAttrs: DisplayAttrs.wn]; 
PopUpMenuMakeStringProc: FormWindow.TextHintsProc; 

ReplaceContinueWithStart: PROC; 

ReplaceStartWithContinue: PROC; 

ScanBatchCheckAndAdd: PROC [lookup, edit: LexiconDefs.Lexicons]: 

ScopeFromChoice: PROC [scopeChoice: CARDINAL] RETURNS [TxtScanDefs.EnumScope1 = INLINE { 

RETURN[ 

SELECT scopeChoice FROM 
alIText => all, 
remainingText => remainder, 
selectedText => selection, 

ENDCASE => all]}; 

SetDocContext: PROC [doc: DocumentDefs.Handle]; 

SetOocNotEdited: PROC [doc: DocumentDefs.Handle]: 

-- word should be in lexicon "normalized" form 

• SetPair: PROC [list: LexiconDefs.LexiconHandle. word: XString . Reader . wordFlags: TxtScanDefs.ReadonlyWordF1ags, associate: 

XStrlng.Reader, associateFlags: TxtScanDefs.ReadonlyWordFlags] RETURNS [ok: BOOL «• TRUE]; --not ok if list is full 

StartAlternativesGeneration: PROC [lookup: LexiconDefs.Lexicons. word: XStr i ng.Reader, wordFlags: TxtScanDefs.ReadonlyWordFlagsJ; 

StopAlLernativesGeneration: PROC: 

Startchecking: PROC [lookup: LexiconDefs.Lex icons]; 

UpdateWordCountDisplay : PROC [checkCtxt: CheckCtxt]; 

UserEditedDoc: PROC [doc: DocumentDefs.Handle] RETURNS [BOOL]; 

}. -- of Spei1ingCheckerDefs 

LOG (date - person - action) 

5-Jun-84 16:34:14 - Walden - OS5 release version 

lG-Jan-85 11:13:58 - Marks - Removed reference to StarAttributeTypeForgotlDefs by assigning displayAttrType the value 

NSAssignedTypes.firstStarType + 39 rather than StarAttributeTypeForgotlDefs.spellingChecker2. This may need to be fixed at a later 

time. 

9 Mar-85 10:15:25 - Marks - Update for OS6. 

9-Apr-86 9:59:05 - Maybury - Changed SCScanCtxtObject to include WordScanCtxtObject as a component (vs. being a replica). 
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-- File: SpellingCheckerMenuPack.mesa - last edit: 

-- 8artlett:0SBU South:Xerox 2-Dec-87 13:28:08 
— Marks.ES 16-Nov-87 18:12:36 

Walden 24-Jul-87 16:37:57 

-- Lewis:OSBU South:Xerox ll-Oec-86 19:50:30 
--- Maybury.ES 9 Apr-86 13:13:47 
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DIRECTORY 

•Attention USING [Post, PostAndConfirm], 

BlockFriendsDefs USING [InRedliningMode], 

CharDefs USING [Char, Chset. Code, Roman], 

Cursor USING [Set], 

DocumentDefs USING [GetAccess, SetEdited], 

DocUtilDefs USING [FreeSystemDoc, LockSystemDoc], 

Environment USING [Byte], 

FormWindow USING [FreeTextHintsProc. GetBooleanltemValue. GetTextltemValue, 

TextHintsProc], 

HashTableLexiconDefs USING [fileType], 

LexiconOefs USING [ 

AddWord, GetNormalizedWord, LexiconHandle. LexiconlsFul1, Lexicons, 

LookUpWord, OpenLexicon], 

MenuData USING [Addltem, Createltem, ItemHandle, MenuHandle, MenuProc, SwapItem], 

NSFile USING [ 

AttributesRecord, ClearAttributes. Close, GetAttributes, GetType, Handle, 
OpenByReference, Reference], 

Process USING [ 

Abort. DisableTimeout, EnableAborts, InitializeCondition, 
priorityBackground, SetPriority], 

ProductFactoring USING [Enabled], 

SchemaOefs USING [Lschema], 

Selection USING [CanYouConvert, Convert, Enumerate, EnumerationProc, Free, Value], 

Space USING [ScratchMap], 

Spel1 ingCheckerDefs USING [ 

AddOrOeleteWords, checkCtxt, CheckCtxt, ClearHostDocCs, CloseUtil, 

ContinueChecking, GetActiveLexicons, Items, LexiconData, MakeDoc, 
nBytesLongestWord. ScanBatchCheckAndAdd. SCScanCtxt, SetDocContext. 

SetDocNotEdited, SetPair. Startchecking. UserEditedDoc], 

$pe11 ingCheckerMessageOefs USING [ 

GetHandle, keySCClose, keySCStart, keySCContinue, 

keySCAddWords, keySCIgnoreWord. keySCCorrect, keySCBatchCheckAndAdd, 

keySCDeleteWord, keySCMakeDocument, keySCMsgMakeDocInProgress. 

keySCMsgMakeOocComplete, keySCMsgUnknownError, 

keySCMsgNoEditLexiconsSpecified, keySCMsgUserCancelled, 

keySCMsgNoLookupLex iconsSpecified, keySCMsgConfirmCorrectionWasntApplied, 

keySCMsgNoWordToCorrect, keySCMsgUserEditedDocCantCorrect, 

keySCMsgCorrectionListlsFul1, keySCMsglgnoreListlsFul1, 

keySCMsgSeIectALexicon, keySCMsgAlternativesWordTooLong, 

keySCNoAlternatives, keySCMsgCantOpenLexicon, keySCMsgReadOnlyAccess], 

StarPFOptions USING [starSpel1ing], 

StarWindowShe11 USING [ 

EnumeratePopupMenus, GetRegularCommands, GetZone, Handle, MenuEnumProc], 

TextutiIDefs USING [ 

AppendNumber, OeleteChar, InsertChar, Rdr, ReplaceChar, 

ResetWriter, TextSegmentFromXString. WLength], 

TIP USING [UserAbort], 

TxtBlockOefs USING [BumpBlockaddr, Order, Set81ockaddr], 

TxtOefs USING [TextSegment, textSegment.Nil ], 

TxtEdltDefs USING [AqTxtCtxt, BeginEdit, DestroyTextSegment, EndEdit. ReplaceWIthString], 
TxtEditExtraiDefs USING [ReplaceWithStringForRedlining], 

TxtScanDefs USING [ 

GetWordFlags, ReadonlyWordFlags, ScanWords, WordFlags, WordFlagsObject, 

WordProc], 

XChar USING [Character, CharRep, Code, Make, not, Set], 

XCharPropS USING [Case, GetLetterRange, IsLetter, IsUpperCase]. 

XCharSetO USING [CodesO, Make], 

XCharSets USING [Sets], 

XFormat USING [DecimalFormat], 

XMessage USING [Get, Handle], 

XString USING [ 

AppendChar, AppendReader, ByteLength, Bytes, Character, CopyReader. Equal, 

Equivalent, First, FreeReaderBytes, FreeWriterBytes, FromNSString, 

InsufficientRoom, NewWriterBody, NthCharacter, 

nulIReaderBody, Reader, ReaderBody, ReaderFromWriter, 

ScanForCharacter, Writer, WrlterBody, WriterBodyFromSTRING]; 

SpellIngCheckerMenuPack: MONITOR 
IMPORTS 

Attention, B1ockFriendsDefs, CharDefs, Cursor. DocumentDefs, DocUtilDefs, 

FormWindow, LexiconDefs, MenuData, NSFile, Process, 

ProductFactoring, Selection, Space, SpellingCheckerDefs, 

SpellingCheckerMessageDefs, StarWindowShel1, TIP, 

TxtBlockOefs, TxtEditDefs, TxtEditExtraiDefs, TxtScanOefs, TextUti1Def$, 

XChar, XCharPropS, XCharSetO, XMessage, XString 
EXPORTS SpellingChedkerDefs 
SHARES SchemaOefs, XString - 
BEGIN 

OPEN FW: FormWindow, Spel11ngCheckerDefs, Spel1ingCheckerMessageDefs, TextUtiTDefs, 

XM: XMessage, XS: XString: 

Bug: SIGNAL [Bugtype] = CODE; 

Bugtype: TYPE = [impossible, badValue, error}; 
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ChangeStatus: TYPE = (changed, caseChanged, noChange}; 

« CONSTANTS » 

h: XMessage.Handle ~ Spel 1 ingCheckerMessageDefs .GetHandle[] ; 
lengthAlternativesList: CARDINAL = 1024; 

<< VARIABLES » 

- the 50 ReaderBody's will fit on one page. 8y allocating them using Space.ScratchMap they will be out of the global frame. If the 
range of altWordArray is ever changed, the number of pages requested must be checked. 

AqWordArray: TYPE = ARRAY [0..50) OF XS.ReaderBody: 

AltWordArray: TYPE = LONG POINTER TO AqWordArray; 
al tWordArray; AltWordArray «- Space. ScratchMap[l ] ; 

StartMenuItem, continueMenuItem: MenuData. Itemllandle *• NIL; 
myZone: UNCOUNTED ZONE «- NIL; 

--- PROCS 

- PUBLIC 


AddPopupMenu: PUBLIC PROC [shell: StarWindowShel1.Handle] = { 

OPEN MenuData; 

batchCheckAndAdd: XS.ReaderBody «- XM,Get[h, keySCBatchCheckAndAdd]; 
delete: XS.ReaderBody «- XM.Get[h, keySCDeleteWord]; 
makeDocument: XS.ReaderBody «- XM.Get[h, keySCMakeDocument]; 
z: UNCOUNTED ZONE *■ StarWindowShel 1 .GetZone[she 11 ] ; 
menuEnumProc; StarWindowShel1.MenuEnumProc - { 

-- PROC [menu: MenuData.Handle] RETURNS [stop: BOOL *■ FALSE]; 

AddItem[menu, Createltem[zone; z, name: ©batchCheckAndAdd, proc; BatchCheckAndAdd]]; 

AddItem[menu, CreateItem[zone: z, name: ©delete, proc: DeleteWords]]; 

AddItem[menu, Createltem[zone: z, name: ©makeDocument, proc: MakeDocument]]; 

Stop «• TRUE; 

-- NOTE: This Is an icky way to add items to the aux menu, but BWS won't support a direct mechanism to do this. Hopefully, one day 
soon, they will see the error in their ways and amend this. (Marks, 3/85) 

StarWindowShel1.EnumeratePopupMenus[shel1, menuEnumProc]: 

}; -- AddPopupMenu 

AddMenuCommands: PUBLIC PROC [sws: StarWindowShell.Handle, itemData: LONG UNSPECIFIED] = { 

OPEN MenuData; 

menuHandle: MenuHandle *■ StarWindowShel 1 .GetRegularCommands[sws] ; 

close: XS .ReaderBody «- XM.Get[h, keySCClose]: 

continue: XS.ReaderBody *■ XM.Get[h, keySCContinue] ; 

start: XS .ReaderBody *■ XM.Get[h, keySCStart]; 

addWords: XS .ReaderBody «■ XM.Get[h, keySCAddWords]; 

ignoreWord: XS .ReaderBody <- XM.Get[h, keySCIgnoreWord]; 

correct: XS.ReaderBody *■ XM.Get[h, keySCCorrect]; 

z: UNCOUNTED ZONE «■ StarWindowShel 1 ,GetZone[sws] ; 

startMenuItem <■ CreateItem[zone: z, name: ©start, proc: Start, itemData: itemData]; 
continueMenuItem «- CreateItem[zone: z. name: ©continue, proc: Continue, ItemData: itemData]; 


-- non-standard property sheet commands 
AddItem[menuHandle, Createltem[zone: z, 
AddItem[menuHandle, startMenuItem]; 
AddItem[menuHandle, Create!tem[zone: z, 
AddItem[menuHand1e, Createltem[zone: z, 
AddItem[menuHandle, CreateItem[zone; z. 


name: 

name: 
name: 
name: 


©close, proc; Close. itemData: itemData]]; 

©addWords, proc: AddWords, itemData: itemData]]: 
©ignoreWord, proc: IgnoreWord, itemData: itemData]]: 
©correct, proc: Correct, itemData: itemData]]; 


}; AddMenuCommands 


CreateAlternativesProcess: PUBLIC PROC RETURNS [PROCESS] = { 
RETURN[FORK GenerateAlternativesInBkgd]: }; 


DestroyAlternativesProcess: PUBLIC PROC [p: PROCESS] = { 
StopAlternativesGeneration[]; 

Process.Abort[p]; 

JOIN p; }; 


-- PRIVATE 


AddWords: MenuData.MenuProc = {Spel1ingCheckerDefs.AddOrDeleteWord$[add]}; 


BatchCheckAndAdd: MenuData.MenuProc - { 
edit, lookup: LexiconDefs.Lexicons; 

[lookup: lookup, edit; edit] ** GetActiveLexicons[]; 

IF edit = NIL THEN { --lookUp=NIL is ok, means don't look up 

msgNoEditLexiconsSpecified: XS.ReaderBody *■ XM.Get[h, keySCMsgNoEdltLexiconsSpecified]; 
Attention.Post[@msgNoEditLexiconsSpecified]} 

ELSE ScanBatchCheckAndAdd[lookUp: lookup, edit: edit]: 

}; -- BatchCheckAndAdd 

Close: MenuData.MenuProc = [ 

SpelIingCheckerDefs.CloseUtil[window, itemData]; 

Continue: MenuData.MenuProc = { 
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checkCtxt: CheckCtxt *• LOOPHOLE[itemData, CheckCtxt]; 
lookup: LexiconOefs.Lex icons = GetAct1velexicons[].lookup; 


IF TIP.UserAbort[checkCtxt.sw$] THEM { 

SetDocContext[NIL]; -- pops enumerators, replaces Continue 

{wb: XS.WrlterBody «- XS.NewWriter'Body[40. checkCtxt.zone] : 
r: XS..Reader; 

msgUserCancelled: XS.ReaderBody XM.Get[h, keySCMsgUserCancel led] ; 

XS.AppendReader[@wb, @msgUserCancelled]; 

TextUtiIDef s.AppendNumber[ 

@wb, LONG[INTEGER[checkCtxt.scScanCtxtObject.nProcessed]], 

XFormat.DecimalFormat]; 
r <- XS.ReaderFromWriter[@wb]; 

Attention.Post[r]; 

XS.FreeWriterBytes[@wb]: 

}; 

RETURN: 

}: 

IF lookup = NIL THEN { 

msgNoLookUpLexiconsSpecifled: XS.ReaderBody *■ XM.Get[h, keySCMsgNoLookUpLexiconsSpecified]; 

Attention.Post[@msgNoLookUpLexiconsSpecified]; } 

ELSE { 

msgConfirmCorrectionWasntAppl ied: XS.ReaderBody *■ XM,Get[ 
h, keySCMsgConfirmCorrectlonWasntApplied]; 

IF checkCtxt.scScanCtxtObject.wordScanCtxtObject.scanCtxtObject.ee # NIL --in the middle of checking words 
AND CorrectionParmChanged[].status # noChange -user edited the parm since we first presented a misspelling 
AND ~Attention.PostAndConfirm[@msgConf1rmCorrectionWasntApp1ied].confirmed 
THEN RETURN: 

SpellingCheckerDefs.ContinueChecking[lookup]: 

}: 

}; -- Continue 


is the current value of the correction parm different from misspelling parm (latter value is in ’word’ string) 
-- font changes don't count, case changes do... 

Correct: MenuData.MenuProc - f 

c: CheckCtxt *■ LOOPHOLE[ i temData. CheckCtxt]; 
aqfxtCtxt: TxtEaitDefs.AqTxtCtxt: 
bumpedOut: BOOL; 

scSC: SCScanCtxt = @c.scScanCtxtObject: 
correctionR: XS.ReaderBody: 

IF scSC.wordScanCtxtObject.ts = TxtDefs.textSegmentNi1 THEN { 

msgNoWordToCorrect: XS.ReaderBody *- XM.Get[h. keySCMsgNoWordToCorrect]; 

Attention.Post[@msgNoWordToCorrect ]; 

RETURN: }; 

IF UserEditedDocfc.doc] THEN ( 

msgUserEditedDocCantCorrect: XS.ReaderBody «- XM.Get[h, keySCMsgUserEditedDocCantCorrect] ; 
SetDocContext[NIL]; -- pops enumerators, replaces Continue 

Attention.Postr@msqUserEd1tedOocCantCorrect]; 

RETURN: 

}; 


IF DocumentDefs.GetAccessCc.doc] = read THEN { 

msgReadOnlyAccess: XS.ReaderBody *- XM.Get[h. keySCMsgReadOnlyAccess]; 
SetDocContext[NlL]; 

Attention.PostfQmsqReadOnlyAccess ]; 

RETURN; 

}; 


correctionR <- FormWindow.GetTextItemValue[ 
c.fw. Items.correction.ORD, c.zone]; 


--don't apply empty/unchanged correction 
[F (XS.ByteLength[ScorrectionR] = 0) 

OR (CorrectionChanged[@correctionR].status = noChange) THEN { 

XS.FreeReaderBytes[@correctionR. c.zone]; RETURN; }; 

<<If ts.blockaddrLast points to same char as range.blockaddrLast THEN bump range.blockaddrLast +1. bump -l after replacing, 
don’t have to worry about range.blockaddrFirst though, because we are setting it to the first char of the new word anyway, 
note that only ts.blockaddrLast can coincide with range.blockaddrLast>> 

WITH e: scSC.wordScanCtxtObject.scanCtxtObject.ee SELECT FROM 
text a > 

IF TxtBlockDefs.Order[scSC.wordScanCtxtObject.ts.blockaddrLast, e.range.blockaddrLast] * 
equal THEN { 

[] «- TxtBlockDefs .BumpBlockaddr[e . range .blockaddrLast. 1. TRUE]: 
bumpedOut *■ TRUE; 

} 

ELSE bumpedOut «■ FALSE: 

ENDCASE; 

ClearHostOocCs[]; 

fxtEditDefs.BeginEdit[@aqTxtCtxt]; 

IF BlockFriendsDefs.InRedliningMode[] THEN 

TxtEditExtralDef s.ReplaceWithStr1ngForRedlining[ 

SaqTxtCtxt. @scSC.wordScanCtxtObject.ts, ^correctionR] 

ELSE TxtEditDefs.ReplaceWithStrtng[ 

SaqTxtCtxt, QscSC.wordScanCtxtObject.ts, ©correctionR]; 

TxtEditDefs.EndEdit[@aqTxtCtxt]; 


We 
AI so 
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-- For old style documents need to set edited bit: so will update time-stamp, 

[] «- DocumentOefs.SetEditedfc.doc]; 

SetOocNotEditedfc.doc]; 

IF c.lastCorrectlonValue ft XS.nulIReaderBody THEN 
XS.FreeReaderByte$[@c.lastCorrectionValue, c.zone]: 
c. lastCorrectionValue «- correctionR; 

WITH e: seSC.wordScanCtxtObject.scanCtxtObject.ee SELECT FROM 
text => { 

TxtBlockDefs.SetBlockaddr[ 

blockaddr; e.range.blockaddrFirst, 

blockaddrSource: scSC.wordScanCtxtObject.ts.blockaddrFirst]: 

IF bumpedOut THEN 

[] «- TxtBlockOef s .BumpBlockaddr[e . range. b lockaddrLast, -1, FALSE]: 
e.endOfRange *■ FALSE: 

}: 

ENDCASE: 

--note: repeated invocation of Correct will simply update the association with the original word; thus the pair-list will always 
reflect the most recent correction of the ORIGINAL 
IF FW.GetBooleanItemValue[ 

c.fw, Items.autoCorrect.ORD] THEN { 
correctionFlags: TxtScanDefs.WordFlagsObject; 

TxtScanOefs.GetWordFlags[@correct1onR, GcorrectionFlags]: 

IF ~SetPair[ 

list: c.correctionL ist, word: Rdr[@scSC.normalizedWord], 
wordFlags: @$cSC.wordScanCtxtObject.wordF1ags, associate: ^correctionR, 
assoclateFlags: QcorrectionFlagsj.ok 
THEN { 

msgCorrectionListlsFul 1 : XS.ReaderBody *• XM.Get[h. keySCMsgCorrectionListlsFul 1 ] : 

Attention.Post[@msgCorrectionListlsFul1]: 

RETURN; }; 

}; 


Continue[window, menu, itemOata]: 
-- Correct 


<< conventions for the "Correction” text parm and checkCtxt.lastCorrectionValue: to detect if the Correction parm has been changed 
since initially set or since the last "Correct" operation 
parm initially empty, checkCtxt.IastCorrectionValue = nulIReaderBody 

when a word is found in interactive mode, it is copied into the parm. and checkCtxt.lastCorrectionValue is set to the string (ie, 
whenever a new value is set into the Correction parm programmatically the same value is remembered in checkCtxt.lastCorrectionValue) 

when a source text word is changed via Correct, the current value in checkCtxt.lastCorrectionValue is destroyed, and it is then set to 
the newly applied value 

if the user has edited the parm since the last programmatic setting or the last Correct, the parm value will not match the remembered 
va i ue 

so, lastCorrectionValue remembers the last value in the parm (which matches the state of the source text), and whenever that is 
different from the current textparm value, it can be inferred that the parm has been edited. Font changes don't count, case changes 
do [XS.Equal considers case]) 

if there is a value for sc.word, there should always also be one (maybe 0 length) for c.IastCorrectionValue 
>> 

CorrectionChanged: PROC [currentValue: XS.Reader] 

RETURNS [status: ChangeStatus] = [ 

OPEN c: checkCtxt; 

RETURN[ 

SELECT TRUE FROM 

c.lastCorrectionValue = XS.nulIReaderBody => 

IF XS.ByteLength[currentValue] > 0 THEN changed ELSE noChange, 

XS.Equal[currentValue, @c.lastCorrectionValue] => noChange. 

XS.Equivalent[currentValue, @c.lastCorrectionValue] => caseChanged, 

ENDCASE => changed]; 

}; -- CorrectionChanged 


CorrectionParmChanged: PROC RETURNS [status: ChangeStatus] = [ 
correctionR: XS.ReaderBody «- FormWindow.GetTextltemValue[ 
checkCtxt.fw, I terns.correction.ORD, myZone]; 

-- font style changes don't count 
status «- CorrectionChanged[@correct1onR]; 

}; -- CorrectionParmChanged 


DeleteWords: MenuData.MenuProc = (Spel1IngCheckerDefs,AddOrDeleteWords[delete]}: 


IgnoreWord: MenuData.MenuProc = { 

checkCtxt: CheckCtxt «- LOOPHOLE[itemOata, CheckCtxt]; 

[OPEN scSC: checkCtxt.scScanCtxtObject; 

IF scSC.wordScanCtxtObject.scanCtxtObject.ee ft NIL THEN ( --in the middle of checking words 
a; ARRAY [0..1) OF Lex iconDef s . Lex iconllandl e <- [checkCtxt. ignoreList]; 
isFull: BOOLEAN *- FALSE: 

[] <- LexiconDefs .AddWord[ 

DESCRIPTOR[a]. Rdr[@scSC.normalizedWord], OscSC.wordScanCtxtObject.wordF!ags ! 
LexiconDefs.LexiconlsFull => { 

msglgnoreListlsFul 1 : XS.ReaderBody <- XM.Get[h, keySCMsglgnoreListlsFul 1 ] ; 

Attention.Post[@msgIgnoreListlsFul1]; 
isFull «• TRUE: 

CONTINUE}]; 

IF -isFull THEN Continue[window. menu. itemOata]: 
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}; 

}! 

}: -- IgnoreWord 


MakeDocument: MenuData.MenuProc ■ ( 

OPEN c: checkCtxt: 

-- *** THIS IS JUST A HACK BECAUSE StarFilerypeForgotDefS DOES NOT CURRENTLY EXIST. PREVIOUSLY™! INSTEAD OF DEFINING 1 ex i coil Type, 
THE VALUE StarFileTypeForgotDefs.lexicon WAS USED. 

msgSelectALexicon: XS.ReaderBody XM.Get[h, keySCMsgSelectALexIconJ: 

MakeDocForLexIcon; PROC [ 

lexicon: Lexicon.Defs .LexiconHandle . name: XS.Reader] = { 

IF lexicon ff NIL THEN ( 

msgMakeOocInProgress: XS.ReaderBody *■ XM.Get[h, keySCMsgMakeDocInP.rogress] : 
msgMakeDocComplete: XS.ReaderBody «■ XM.Get[h. keySCMsgMakeDocComplete]; 
msgUnknownError: XS.ReaderBody *■ XM.Get[h, keySCMsgUnknownError]; 

Ok: BOOL; 

Attention.Post[@msgMakeDocInProgress]: 
ok «- MakeDoc[lexicon, name]: 

Attention.Post[ 

(IF ok THEN ©msgMakeDocComplete ELSE ©msgUnknownError)]; 

} 

ELSE { 

msgCantOpenLexicon: XS.ReaderBody «* XM.Get[h, keySCMsgCantOpenLexIcon]; 

Attention.Post[©msgCantOpenLexicon]; }; 

}; - MakeDocForLexicon 

EnumerationProc: Selection.EnumerationProc = [ 

ConvertToDoc[LOOPHOLF.[element. value , LONG POINTER TO NSFi 1 e . Reference]] ; 

Selection.Free[@element]; 

}: 

ConvertToDoc: PROC [value: LONG POINTER TO NSFi1e.Reference] = { 

FOR i: CARDINAL IN [0..c.lexicons.nLex icons) DO 

lex: LONG POINTER TO LexIconData <- @c. lexicons[ i]: 

IF lex.ref = valuet THEN ( 

MakeDocForLexicon[lex.lex icon , lex.name]: EXIT}: 

REPEAT 

FINISHED O { 

lexiconFile: NSFi1e.Handle - 

NSFile.OpenByReference[valuet]; 

IF NSFile.GetType[lexiconFile] = HashTableLexiconDefs.fi1eType THEN { 

-- DO £ NEED TO CHECK THAT fileType IS DOC HERE? (StarFi1eTypes. NSFi1e.GetRef) 
lexicon: LexiconDefs.LexiconHandle = LexiconDefs.OpenLex1con[ 
lexiconFile: lexiconFile, readonly: TRUE, z: c.zone]: 
ar: NSFi 1 e.AttributesRecord <- TRASH; 
rb: XString.ReaderBody; 

NSFile.GetAttributes[lexiconFile, [interpreted: [name: TRUE]], ©ar]; 
rb «• XString.FromNSStr1ng[ar.name]; 

MakeDocForLexicon[lexicon, ©rb]; 

NSFile.ClearAttributes[@ar]; 

IF lexicon # NIL THEN lexicon.close[lexiconJ; 

> 

ELSE Attention.Post[@msgSelectALexicon]; 

NSF11e.Close[lexiconFile]; 

}; 

ENDLOOP; 

}; --ConvertToDoc 

IF Selection.CanYouConvert[file] THEN { 

element: Selection .Value «■ Selection.Convert[f lie, myZone]; 

ConvertToDoc[LOOPHOLE[element.value, LONG POINTER TO NSFi1e.Reference]]; • 

Se1ection.Free[6element]; 

} 

ELSE IF Selection.CanYouConvert[file. TRUE] 

THEN [] *• Selection. Enumerate[proc: EnumerationProc, target: file] 

ELSE Attention.Po$t[©msgSelectALexicon]; 

}; -- MakeDocument 


PoptJpMenuMakeStringProc : PUBLIC FormWindow. TextHintsProc - { 

OPEN c: checkCtxt; 

f reeHIntProc : FormWindow.FreeTextHintsProc «- NIL; 

InvalidAltList: PROC RETURNS [BOOL] = ( 

RETURN[c.InvalIdAltLlst OR NewAlternative$Word[]]}; 

NewAlternativesWord: PROC RETURNS [new: BOOL] = { 

1sWord: LONG STRING = [nBytesLongestWord]; 
word: XS.WrlterBody *■ XS.WriterBodyFromSTRING[ 
s: 1sWord, homogeneous: TRUE]; 

AppendAltWordFromCorrectionParm[8word, NIL]; 

-- note that this test covers the cases where the new alt word is 0-length or the old alt-word was 0-length or both or neither 
new *■ ~XS.Equal[Rdr[@word] , Rdr[@c . al ternativesWord]]; 

}: 

WaitAlternatlvesDone: ENTRY PROC * { 

ENABLE UNWIND => NULL; 

WHILE checkCtxt.generatingAlternatives DO 

WAIT checkCtxt.cDoneGeneratingAIternatives; ENDLOOP: 

}: 
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IF GeneratingAlternatives[] THEN { --generation in progress 

--see if the user has changed anything that would Invalidate the current list 
IF InvalidAltLIst[] THEN { 

StopAlternativesGenerat1on[]; GetAlternative$[]: } 

ELSE { 

Cursor,Set[hourGlass]; 

WaitAlternativesDone[]; 

Cursor.Set[textPointer]; 

}: 

} 

ELSE --either done, or never started 

IF InvalidAltL1st[] THEN GetAlternatives[]; 

IF c.nWords <= 0 THEN { 

al tWordArray[0] «- XM.Get[h, keySCNoAl ternat i ves]; 

RETURN[DESCRIPTOR[altWordArray, 1], freeKintProc]} 

ELSE { 

string: XS.Reader *• XS. CopyReader[r: Rdr[@c .al ternatives] , z: c.zone]; 

FOR i: CARDINAL IN [0..c.nWords) DO 

altWordArray[i] «- XS.ScanForCharacter[ 

String, 

XCharSetO.Make[XCharSetO.CodesO.newline], 
ignore].front; 

ENDLOOP; 

R£TURN[DESCRIPTOR[altWordArray, c.nWords]. freeHintProc] 

}; 


}; -- PopUpMenuMakeStringProc 


(ieneratingAlternatives: ENTRY PROC RETURNS [BOOL] = { 

ENABLE UNWIND = > NULL; R£TURN[checkCtxt.gene ratingAlternatives]}; 


-- gets a normalized word 

AppendA1tWordFromCorrectionParm: PROC [ 

altWord: XS.Writer, flags: TxtScanDefs.WordFlags] = { 

tsBlock: TxtDefs.TextSegment; 

spring: XString.ReaderBody; 

Show: TxtScanDefs.WordProc - { 

XS.AppendReader[to; altWord. from: word]; 

IF flags # NIL THEN flagst «- wordFlagst; 
status «- abort; --only do the first word 
}; -Show 

string «- FW.GetTextItemValue[ 

checkCtxt.fw, I terns.correction.ORO, myZone]; 

<< The scratchBlock was created in the SystemDoc by 

Spel1ingCheckerWnPack.Init. Since the block resides in the SystemDoc, 
we must prohibit every other editing action in that doc until we're 
through. >> 

DocUtiIDefs.LockSystemDoc[]; 

(ENABLE UNWIND = > DocUtllDefs.FreeSystemDoc[]; 

tsBlock <- TextUtilDefs .TextSegmentFromXString[@string, checkCtxt. scratchBlock] ; 

IF flags.# NIL THEN flags.nChars <-0; 

IF tsBlock H TxtDefs.textSegmentNil THEN { 

[] <- TxtScanDefs.ScanWords[ 

range: tsBlock, wordProc: Show. nBytesLongestWord: nBytesLongestWord]; 
TxtEdltDef s.DestroyTextSegment[@tsBlock]; 

}: --else leave altWord empty 

}; -- ENABLE 

DocUtilDefs.FreeSystemDoc[]; 

}: -- AppendAltWordFromCorrectionParm 


GetAlternatives: PROC [] = { --call from foreground... 

OPEN c: checkCtxt: 

lookup: LexIconDefs.Lexicons = GetActiveLexicons[].lookup: 

Cursor.Set[hourGlass]: 
c. rsAlternatives <- [0, 0]; 

ResetWr1ter[@c.alternativesWord]; 

AppendAltWordFromCorrect1onParm[ 

Gc.alternativesWord, @c.alternativesWordFlags]; 
c . inval idAl tList «- c. abortAl ternatives *- FALSE; 

GenerateAlternat1ves[ 

lookup, Rdr[@c.alternativesWord], @c.alternativesWordFlags, 
@c.alternatives]; 

Cursor.Set[textPointer]; 

): 


StopAlternativesGeneration: PUBLIC ENTRY PROC - { 

ENABLE UNWIND => NULL; 
checkCtxt. abortAl ternatives <- TRUE; 

WHILE checkCtxt.generatlngAlternatives DO 

WAIT checkCtxt.cDoneGeneratingAlternatives: ENDLOOP: 
checkCtxt .abortAl ternatives «- FALSE; 

checkCtxt. inval IdAltList *■ TRUE; --current list is invalid 

}: 


-- word must be normalized 

StartAlternativesGeneration: PUBLIC ENTRY PROC [ 
lookup: IexIconDefs.Lex icons . word; XS.Reader 
wordFlags: TxtScanDefs.ReadoniyWordFlags] = { 
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ENABLE UNWIND => NULL; 

IF -checkCtxt.generatingAlternatives THEN { 

OPEN c: checkCtxt; 

Re$etWriter[@c .alternativesWord]; 

XS.AppendReader[to: ©c.alternativesWord, from; word]; 
c . al ternati vesWordFl ags *• wordFlags+i 
c.invalidAltList «■ FALSE; 
c.abortAlternatives *• FALSE; 
c.alternativesLookUp «- lookup; 
c.generatingAlternatives *■ TRUE; 

NOTIFY c.cGenerateAlternatives; 

}; 

}; 


AlternativesStopped: ENTRY PROC RETURNS [BOOL] - [ 

ENABLE UNWIND => NULL; RETURN[checkCtxt.abortAlternatives]}; 


- word must be normalised 
GenerateAlternatives: PROC [ 

lookup: LexiconDefs.Lexicons, word: XS.Reader, 

wordFlags: TxtScanDefs.ReadonlyWordFlags, altList: XS.Writer] = { 

OPEN c: checkCtxt; 

c 

ENABLE XS.InsufficientRoom => CONTINUE; 

c.nWords «- 0; 

ResetWriter[alt.List]; 

IF lookup = NIL THEN [ 

msgNoLookUpLex iconsSpecif ied : XS. ReaderBody «■ XM.Get[h, keySCMsgNoLookUpLex iconsSpec if ied]; 
XS.AppendReader[to: altList. from: ©msgNoLookUpLexiconsSpecif ied]; 
c. nWords *- 1 ; 

RETURN; 

}; 


IF XS.ByteLength[word] > nBytesLongestWord THEN f 

msgAl ternati vesWordTooLong : XS. ReaderBody «- XM.Getfh. keySCMsgAlternativesWordTooLong]; 

XS.AppendReader[to: al tList, from: ©msgAlternativesWordTooLong]: 
c.nWords - 1; 

RETURN; 

}: 

IF wordFlags.nChars > 0 THEN { 

IsNorm; LONG STRING - [nBytesLongestWord +• 10]; 

IsTemp: LONG STRING - [nBytesLongestWord +■ 10]; 
wbNorm: XS. Wri terBody <- XS .WriterBodyFromSTRING[ 
s: IsNorm, homogeneous: TRUE]; 

wNorm: XS.Writer = ©wbNorm; -- buffer for guys below to normalize string into before lookup 
wbTemp: XS.WriterBody *■ XS.WriterBodyFromSTRING[ 
s: IsTemp, homogeneous: TRUE]; 

wTemp: XS.Writer = ©wbTemp; -- buffer for guys below to copy string into before editing it 
-- wNorm must be zero-offset 

wbNorm. of f set «- wbNorm. limit «- 0; --if not already. Claim this is ok. since wbNorm. bytes is the start of the allocation unit, 
and we can use them if we want. This is prompted by XString’s returning bytes = string pointer, offset = 4 in current 
implementation (6-20-84); we will use the length and maxlength part of the string as bytes also 

CheckWord[lookUp, word, wordFlags, wNorm, altList, ©c.nWords]; - 1 

IF AlternativesStopped[] THEN RETURN; 

Deletions[lookUp, word, wordFlags. wTemp, wNorm. altList. ©c.nWords]; -- n (for n>l) 

IF AlternativesStopped[] THEN RETURN; 

SubstitutionspookUp, word, wordFlags, wTemp, wNorm, altList, ©c.nWords]; -- 25n 
IF AlternativesStopped[] THEN RETURN; 

Transpositions[lookUp, word, wordFlags, wTemp, wNorm, altList, ©c.nWords]; -- n-1 - (M of same-letter pairs), for n>l 
IF Alternat1vesStopped[] THEN RETURN; 

InsertlonspookUp, word, wordFlags, wTemp, wNorm, altList. ©c.nWords]; -- 26*(n+l) 

IF AlternativesStOppedf] THEN RETURN; 

}; 

IF WLength[altList] = 0 THEN { 

msgNoAl ternat i ves : XS .ReaderBody *- XM,Get[h, keySCNoAl ternati ves] ; 

XS.AppendReader[to: altList, from: ©msgNoAlternatives]; }; 

}; --ENABLE block 

}: --GenerateAlternatives 


GenerateAlternativesInBkgd: PROC = [ 

ENABLE ABORTED => CONTINUE; 

NotifyAlternativesDone: ENTRY PROC = { 

ENABLE UNWIND => NULL; 

checkCtxt.generatlngAlternatives «- FALSE; 

NOTIFY checkCtxt.cDoneGeneratlngAlternatives: 

}: 

WaitAlternativesStart: ENTRY PROC = { 

ENABLE UNWIND => NULL: 

UNTIL checkCtxt.generatlngAlternatives DO 

WAIT checkCtxt.cGenerateAlternatives: ENDLOOP: 
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}; 


Process.SetPriority[Process.priorityBackground]; 

DO 

OPEN c: checkCtxt: 

Wal tAI ternatlvesStartn; 
c. rsAl ternatlves «- [0, 0]; 

GenerateAlternatives[ 

c.alternatIvesLookUp, Rdr[@c. alternativesWord], 
@c.a 1ternatIvesWordFIags, @c .alternat ives]; 
NotifyAlternativesDone[]; 

ENDLOOP; 


Insertions: PROC [ 

lookup: LexiconDefs.Lexicons, word: XS.Reader, 

wordFlags: TxtScanDefs.ReadonlyWordFlags, wTemp, wNorm, strList: XS.Writer, 
nWords: LONG POINTER TO CARDINAL] = 

{ 

wordFl agsLocal : TxtScanDef s . WordF 1 agsObject *■ wordFlagst; 
c, cPrev: XChar.Character; 
i: CARDINAL 0; 
cFirst, cLast: XChar.Character; 

IF wordFlags.nChars - 0 THEN RETURN: 

wordF 1 agsLocal . nChars <- wordFlagsLocal. nChars+l: -- doing insertions! 

[cFirst, cLast] <- GetLetterRange[ 
chset: XChar.Set[XS.Flr$t[word]], 

case: (IF wordFlags.case = allUpper THEN upper ELSE lower)]; 

IF cFirst = XChar.not THEN RETURN; 
cPrev *• XChar.not; 

FOR i: CARDINAL IN [0. .wordFlags. nChars] DO -- go to nChars*-! here 
ResetWriter[wTemp]; 

XS.AppendReader[to: wTemp, from: word]; 

InsertChar[wTemp, i, LOOPHOLE[cFirst]]: --if i > last string position, put it at the end. 
--don't insert a char same as previous one. to suppress duplicate lookups 
IF cFirst tt cPrev THEN 

CheckWord[ 1 ookUp, Rdr[wTemp|, @wordFlagsLocal , wNorm, strList, nWords]; 

IF AlternativesStOpped[] THEN RETURN; 

LOOPHOLE[c, XChar .CharRep]. set «- XChar. Set[cF i rst J ; 

FOR code: Environment.Byte IN (XChar.Code[cFirst]..XChar.Code[cLastj] DO 
LOOPHOLE[c, XChar.CharRep] . code *- code: 

IF -XCharProps.IsLetter[c] THEN LOOP; may be sparse range 
IF c ft cPrev THEN { 

--case-sensitive compare will get duplicate spellings but only if case differs 
IF AlternativesSt 0 pped[] THEN RETURN; 

[] «• ReplaceChar[wTemp, i, LOOPHOLE[c]] : 

CheckWord[lookUp. Rdr[wTenip], SwordFlagsLocal. wNorm, strList, nWords]; 

}: 

ENDLOOP; 

cPrev «- XS .NthCharacter[word. i]; 

ENDLOOP; 

}: --Insertions 


<< Deletions: word is in normalized form 
leave case flags alone after deletions. This is ok, since: 

1) if case = allLower, or allUpper, clearly ok 

2) if case = firstUpperOnly, probably doesn’t matter; at worst, someone will think that the new word should have it's first char 
upper, which is ok anyway... 

3) if case = mixed. 2 subcases 

only 1 char is upper => deleting it makes it all lower; but if lexicons just insist on an exact match with mixed case, that will 
still be ok since now all lower case 

> l uppercase => deleting any 1 char, word is still mixed >> 

Deletions: PROC [ 

lookup: LexiconDefs.Lexicons, word: XS.Reader, 

wordFlags: TxtScanDefs.ReadonlyWordFlags, wTemp, wNorm, strList: XS.Writer, 
nWords: LONG POINTER TO CARDINAL] = 

c 

c, cPrev: CharDefs.Char; 

wordFlagsLocal: TxtScanDefs .WordFl agsObject <- wordFlagst; 

IF wordFlags.nChars < 2 THEN RETURN: 

wordFl agsLocal. nChars *■ wordFlagsLocal. nChars-1; -- for deletions! 

cPrev *- LOOPHOLE[XChar . not]; 

FOR i: CARDINAL IN [0..wordFlags.nChars) DO 
IF AlternativesStopped[] THEN RETURN; 

ResetWriter[wTempj; 

XS.AppendReader[to: wTemp, from: word]; 
c <- DeleteChar[wTemp, i]; 

IF c # cPrev THEN --case-sensitive compare, to allow duplicate spellings with different case 
CheckWord[lookUp, Rdr[wTemp], OwordFlagsLocal, wNorm, strList, nWords]; 
cPrev «■ c: 

ENDLOOP; 

); --Deletions 


Substitutions: PROC [ 
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lookup: LexiconDefs.Lexicons. word: XS.Reader. 

wordFlags: TxtScanDefs.ReadonlyWordFlags, wTemp, wNorm. strList: XS.Writer, 
nWords: LONG POINTER TO CARDINAL] = 

{ 

bytes: XS.Bytes; 
limit, byteN: CARDINAL; 
chset: CharDefs.Chset; 
code: CharDefs.Code; 

IF wordFlags.nChars = 0 THEN RETURN; 

ResetWriter[wTemp]; 

XS.AppendReader[to: wTemp, from: word]; 

bytes «• wTemp.bytes; 

1 ini i t *■ wTemp .limit; 

byteN <- wTemp .off set; 

chset «- wTemp.context.prefix; 

-- note: substitutions are done in-place, pad byte remains ok 
UNTIL byteN = limit DO 

IF bytes[byteN] = 377B THEN { 

chset <- bytes[byteN + l]; byteN «■ byteN + 2; }; 

--substitute at byteN 

IF A1ternativesStopped[] THEN RETURN; 

code *- bytesfbyteN]; 

-- returns char in same chset as input char 
BEGIN 

xchar: XChar. Charac te r *■ XChar .Make[chset, code]; -- scratch char 
cFirst. cLast: XChar.Character; 

IF XCharProps . IsLetterfxc.har] THEN { --substitute 
[cFirst, cLast] *• GetLetterRange [ 
chset: chset. 

case: (IF XCharProps.IsUpperCase[xchar] THEN upper ELSF lower)]; 

IF cFirst ¥ XChar.not THEN -- paranoid check... 

FOR codeT: Environment.Byte IN [XChar.Code[cFirst]..XChar.Code[cLast]] DO 
IF A1ternativesStopped[] THEN RETURN; 

LOOPHOLEfxchar , XChar .CharRep]. code «- code!; 

IF -XCharProps.IsLetterfxchar] THEN LOOP; -- may be sparse range 
IF code! ¥ code THEN { 
bytes[byteN] «- codeT; 

CheckWordf1ookUp, Rdr[wremp], wordFlags, wNorm. strList, nWords]; 
bytes[byteN] code: --replace original 
}: 

ENDLOOP; 

}: 

END; 


byteN e byteN +• 1; 

ENDLOOP; 

}; -- Substitutions 

-- Transpositions: word must be normalized, case flag never changes 
Transpositions: PROC [ 

lookup: LexiconOefs.Lexicons, word: XS.Reader. 

wordFlags: TxtScanDefs.ReadonlyWordFlags, wTemp, wNorm, strList: XS.Writer, 
nWords: LONG POINTER TO CARDINAL] = 

c 

c, cPrev: CharDefs.Char; 

IF wordFlags.nChars < 2 THEN RETURN; 
cPrev <- LOOPHOLEfXChar .not]; 

FOR i: CARDINAL IN [1..wordFlags.nChars) DO 
IF AIternatlvesStopped[] THEN RETURN; 

ResetWriterfwTemp]: 

XS.AppendReaderfto: wTemp. from: word]; 
c *■ DeleteCharfwTemp, i]; 

IF c ¥ cPrev THEN { -don't transpose same chars 

-- case-sensitive compare, to get duplicate spellings with different case 

InsertCharfwTemp, 1 - 1, c]; --if insertPos > last string position, then puts it at the end. 

CheckWordf!ookUp, RdrfwTemp], wordFlags, wNorm, strList, nWords]; 

}: 

cPrev «• c; 

ENDLOOP; 

}; --Transpositions 


-- if the normalized form is there, append the original form... 

-- this Is only to be used for Corrections generation 
CheckWord: PROC [ 

lookUp: LexiconDefs.Lexicons, word: XS.Reader, 

wordFlags: TxtScanDefs.ReadonlyWordFlags, wNorm, strList: XS.Writer. 
nWords: LONG POINTER TO CARDINAL] = { 

IF wordFlags.nChars > 0 THEN { 

LexiconDefs.GetNormalizedWordfword, wordFlags, wNorm]; 

IF LexiconDefs.LookUpWordflookUp, RdrfwNorm], wordFlags. TRUE |.found THEN ( 
IF nWords* < 50 THEN { 

IF WLengthfstrList] > 0 THEN --add CR separator 

XS.AppendCharfto: strList, c: LOOPHOLEfCharDefs.RomanfnewLine]]]; 
XS.AppendReaderfto: strList, from: word]; 
nWords* «- nWords* * l; 

}; 

}: 

}: 

} ; -- CheckWord 
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ReplaceContinueWithStart: PUBLIC PROC = { 

OPEN c: checkCtxt; 

menuHandle: MenuOata.MenuHandle «- StarWindowShel1.GetRegularCommands[checkCtxt.sws]: 
IF c.continueShowing THEN 

MenuOata.SwapItem[menu: menuHandle. old: continueMenuItem, new: startMenuItem]; 
c.contlnueShowing <- FALSE; 

}: -- ReplaceContinueWithStart 


ReplaceStartWithContinue: PUBLIC PROC = { 

OPEN c: checkCtxt: 

menuHandle: MenuOata.MenuHandle «■ StarWindowShel1.GetRegularCommands[checkCtxt.sws]; 
IF ~c.continueShowing THEN 

MenuOata.SwapItem[menu: menuHandle. old: startMenuItem. new: continueMenuItem]; 

c . continueShowing «* TRUE; 

}; -- ReplaceStartWithContinue 


Start: MenuOata.MenuProc = { 

lookup: LexiconDefs . Lexicons = GetAct iveLexicons['J. lookup; 

IF lOOkUp = NIL THEN 

msgNoLookUpLex iconsSpecif ied: XS.ReaderBody *- XM.Get[h, keySCMsgNoLooklJpLex iconsSpec i f ied]; 

Attention.Post[@msgNoLookUpLexiconsSpecified] } 

ELSE StartChecking[lookUp]; 

} ; -- Start 


GetLetterRange: PROC [chset: Environment.Byte. case: XCharProps.Case] 

RETURNS [cFirst, cLast: XChar.Character] = INLINE { 

RETURN (IF chset - XCharSets.Sets.1atin.ORD THEN 

IF case r upper THEN [XCharSetO.CodesO upperA.ORD. XCharSetO.CodesO.upperZ.ORO] 
ELSE [XCharSetO.CodesO.lowerA.ORD, XCharSetO.CodesO.lowerZ.ORO] 

ELSE XCharProps.GetLetterRange[chset. case])}: 

In it: PROC ^ { 

<< Initialize SC tool context if the SC is installed in the product >> 

IF ProductFactoring.EnabledfStarPFOptions.starSpel1ing] THEN 
BEGIN 

my Zone «- checkC txt. zone; 

--allocate the string for alternatives list 
checkCtxt.alternatives «■ XS.NewWriterBody[ 

lengthAlternativesList + 1, checkCtxt.zone]; 

checkCtxt.alternativesWord *■ XS.NewWriterBody[ 
nBytesLongestWord, checkCtxt.zone]: 

Process.InitializeCondition[@checkCtxt.cGenerateAlternatives , 1]: 

Process.DisableTimeout[@checkCtxt.cGenerateAlternatives]: 

Process.EnableAborts[@checkCtxt.cGenerateAlternatives] ; 

Process.InitializeCondition[@checkCtxt.cDoneGeneratingAlternatives, 1]: 

Process.OisableTimeout[@checkCtxt.cDoneGeneratingAlternatives]; 

END; 

}; - Init 


-- MAINLINE 
Init[]: 


END. -- Spel1ingCheckerMenuPack 

LOG (date - person - action) 

5-Jun-84 16:50:40 - Walden - 0S5.0 release version 1 

G-Jul-84 11:54:59 - Walden 

17-Jul-84 18:12:42 - D.J. Lewis - Tie Initialization to FeatureDefs product factoring flag. 

9-Mar-85 10:22:13 - Marks - Update to 0S6. 

l2-Mar-85 8:45:04 - Marks - Replace RealToReaderBody with TextUtilDefs.AppendNumber. 

15-Mar-85 15:08:09 - Goodell - ReplaceWithString now conies from TxtEditDefs 

28-Mar -85 11:16:44 Marks - Correctly add SC items to property sheet Aux menu. l-Apr-85 14:42:50 - Marks - Use BWS product factoring. 
12-Apr-85 9:31:17 - Marks - allocate altWordArray using Space.ScratchMap. 

15-Apr-85 15:05:50 - Marks - corret use of Selection.CanYouConvert. 

22-May-85 20:02:27 - Marks - check filetype before convert doc 

26- Jun-85 15:46:12 - Marks - Use TIP.UserAbort. 

31-Jul -85 15:14:34 - Marks - AR15416: keySCMsgConfirmCorrectionWasntApplied changed to be understandable. 

ll-Sep-85 13:13:32 - Marks - AR19939: Correct - set doc edited then set S.C. doc edited bit off. 

27- Sep-85 17:38:00 - Marks - AR209555: CreateAlternatives process is forked and later a Process.Abort is called on it. A JOIN is never 

called, but needs to because an Abort does not kill the process. 

3 Feb-86 13:57:22 - Maybury - Adopted HashTableLexiconDefs.fileType (vs. hackLexicon). 

21-Feb-86 12:57:24 - Bartlett - use LockSystemDoc, FreeSystemDoc 
3-Feb-86 13:57:22 - Maybury - Continue. Correct, IgnoreWord: conform to new SCScanCtxtObject 
5-Dec-86 11:02:40 - Bartlett - support Redlining in Correct 
11-Dec-86 - Lewis - Get IsLetter, IsUpperCase, GetLetterRange from XCharProps. 

26-Mar-87 - Walden - remove nsName from lex info passed to MakeDoc; just create that string on demand inside MakeDoc 

l-May-87 10:15:02 - Marks - use B1ockFriendsDefs Instead of BlockPrivIxtralDefs. 

28- May -8 7 11:19:55 - Walden - Insertions. Substitutions: check for XChar.not from GetLetterRange, no-op when encountered 

24-Jul -87 16:35:58 - Walden - Correct: set endOfRange to FALSE when correcting, make sure word is rechecked even if end of range 

encountered when getting the word 
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7-Aug-8 7 15:46:38 
reader. 

16-Nov-87 17:41:26 
2-Dec-8 7 13:26:32 


Marks - Don't use ToolUti1itiesDefs.GetFileName. In ConverToDoc make calls myself and fix AR13660 by creating own 

Marks - AR 14272 - Continue after IgnoreWord or CorrectWord. 

Bartlett - added UNWIND call to FreeSystemDoc for AR 16204 
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-- File: SpellIngCheckerMessageOefs.mesa - last edit: 
-- Marks.ES 31-Jul-85 15:21:54 

-- Owner: Document Group 


DIRECTORY 

XMessage USING [Handle, MsgKey]; 

Spel1ingCheckerMessageOefs: DEFINITIONS = BEGIN 
OPEN XM: XMessage; 

MsgKey: TYPE = MACHINE DEPENDENT { 

scTitle, scLookUp, scEdit, scScope, scAllText, scRemainingText, scSelectedText, scMisspel1ing. scCorrection, scCheckFrames, 
scAutoCorrect, scAmerEngLexicon, scEmptyLexicon, scClose, scStart, scContinue, scCorrect. scAddWords, scIgnoreWord. 
scBatchCheckAndAdd, scDeleteWord, scMakeDocument, scMoveWindow. scWordslistedlnDoc, scNoAlternatives, scLexiconFolder, 
scConvertLexicons, scMsgSpellingCheckerAlreadyActive. scMsgNeedAppropriateSelection, scMsgCheckingSpelling, scMsgCheckingComplete , 
scMsgllserCancelled, scMsgMustLogln, scMsgBatchAddingWords. scMsgConfirmBatchAddWords . scMsgConfirmDeleteAl1 Words . 
scMsgNoEditLexiconsSpecified, scMsgNoLookUpLexiconsSpecified, scMsgConfirmEditLexicon IsFul1, scMsgConfirmLexiconCantBeOpened, 
scMsgCorrectionListlsFul1, scMsglgnoreListlsFul1, scMsgCantlgnoreMultipleWords, scMsgUserEditedDocCantCorrect. 
scMsgllserEditedDocCantContinue, scMsgNoWordToCorrect, scMsgCorrectionfooLong, scMsgConfirmCorrectionWasntApplied, 
scMsgCantAutoCorrectCaseChange. scMsgCorrectionWasntChanged, scMsgNAdded, scMsgAlIDeleted, scMsgNDeleted, scMsgMakeDocInProgress . 
scMsgMakeDocComplete, scMsgSelectALexicon, scMsgLexiconlsEmpty, scMsgCantOpenLexlcon, scMsgAlternativesWordToolong. 
scMsgUnknownError, scMsgUnimplemented. scLexicon, scMsgReadOnlyAccess, scMsgConfirm, scMsgCancel}; 

keySCTitle: XM.MsgKey = 0: 
keySCLookUp: XM.MsgKey = keySCTitle + l; 
keySCEdit: XM.MsgKey = keySCLookUp + I: 
keySCScope: XM.MsgKey = keySCEdit + 1; 
keySCAHText: XM.MsgKey = keySCScope +■ l; 
keySCRemainingText: XM.MsgKey = keySCAHText + 1; 
keySCSelectedtext: XM.MsgKey ; keySCRemainingText + 1; 
keySCMisspel 1 ing: XM.MsgKey - keySCSelectedText *- I: 
keySCCorrection: XM.MsgKey = keySCMisspc11ing *■ 1; 
keySCCheckFrames: XM.MsgKey = keySCCorrection + I: 
keySCAutoCorrect: XM.MsgKey = keySCCheckFrames 1: 
keySCAmerEngLexicon: XM.MsgKey ■= keySCAutoCorrect *• 1; 
keySCEmp tyLex i con: XM.MsgKey ■= keySCAme rEngLex icon - l; 
keySCClose: XM.MsgKey = keySCEmptyLexicon +■ 1; 
keySCStart: XM.MsgKey = keySCClose + l: 
keySCContinue: XM.MsgKey = keySCStart *■ 1; 
keySCCorrect: XM.MsgKey = keySCContinue -*■ I; 
keySCAddWords: XM.MsgKey = keySCCorrect + 1; 
keySCIgnoreWord: XM,MsgKey 5 keySCAddWords 1; 
keySCBatchCheckAndAdd: XM,MsgKey = keySCIgnoreWord - 1; 
keySCDeleteWord: XM.MsgKey = keySCBatchCheckAndAdd - 1: 
keySCMakeDocument: XM.MsgKey - keySCDeleteWord * 1: 
keySCMoveWindow: XM.MsgKey = keySCMakeDocument + l; 

keySCWordsListedlnDoc: XM.MsgKey = keySCMoveWindow * 1; 

keySCNoAlternatives: XM.MsgKey - keySCWordsListedlnDoc +■ 1; 
keySCLexiconFo ider: XM.MsgKey - keySCNoAl ternatives +■ 1; 
keySCConvertLexicons: XM.MsgKey = keySCLexlconFolder + l; 

keySCMsgSpel 1 ingCheckerAl readyActive : XM.MsgKey = keySCConvertLexicons +• 1; 

keySCMsgNeedApproprlateSelection: XM.MsgKey = keySCMsgSpelIingCheckerAIreadyActive + 1; 

keySCMsgCheckingSpelTing: XM.MsgKey = keySCMsgNeedAppropriateSelection +- 1; 

keySCMsgCheckingComplete: XM.MsgKey = keySCMsgCheckingSpe11ing + L: 

keySCMsgUserCancelled: XM.MsgKey = keySCMsgCheckingComplete l: 

keySCMsgMustLogln: XM.MsgKey - keySCMsgUserCancelled + l: 

keySCMsgBatchAddingWords: XM.MsgKey = keySCMsgMustLogln +■ 1; 

keySCMsgConfirmBatchAddWords: XM.MsgKey = keySCMsgBatchAddingWords + 1; 

keySCMsgConfirmDeleteAllWords: XM.MsgKey = keySCMsgConf i rmBatchAddWords + 1: 

keySCMsgNoEditLexiconsSpecifled: XM.MsgKey = keySCMsgConfirmDeleteAlIWords + 1: 

keySCMsgNoLookUpLexiconsSpecified: XM.MsgKey = keySCMsgNoEditLexiconsSpecified + 1; 

keySCMsgConf IrmEditLexIconlsFul.l : XM.MsgKey = keySCMsgNoLookUpLex.iconsSpecified + 1; 

keySCMsgConfirmLexiconCantBeOpened: XM.MsgKey = keySCMsgConf1rmEdltLexiconlsFul1 + 1; 

keySCMsgCorrectionListlsFul1: XM.MsgKey - keySCMsgConfirmLexiconCantBeOpened * I: 

keySCMsglgnoreListlsFull: XM.MsgKey = keySCMsgCorrectionLlstlsFul1 + 1; 

keySCMsgCantlgnoreMu1 tip 1eWords: XM.MsgKey = keySCMsglgnoreListlsFull + 1; 

keySCMsgUserEditedDocCantCorrect: XM.MsgKey = keySCMsgCantlgnoreMgltipieWords + l; 

keySCMsgUserEdltedDocCantContinue: XM.MsgKey = keySCMsgUserEditedOocCantCorrect + 1; 

keySCMsgNoWordToCorrect: XM. MsgKey = keySCMsgUserEdi tedDocCantContinue *■ 1; 

keySCMsgCorrectionTooLong: XM.MsgKey - keySCMsgNoWordToCorrect + 1; 

keySCMsgConfirmCorrectionWasntApplied: XM.MsgKey = keySCMsgCorrectionTooLong + 1: 

keySCMsgCantAutoCorrectCaseChange : XM.MsgKey -= keySCMsgConf i rmCorrectionWasntAppl ied *■ 1; 

keySCMsgCorrectlonWasntChanged: XM.MsgKey = keySCMsgConfirmCorrectionWasntApplied + 1: 

keySCMsgNAdded: XM.MsgKey = keySCMsgCorrectionWasntChanged +■ 1; 

keySCMsgAl1 Deleted: XM.MsgKey = keySCMsgNAdded + 1; 

keySCMsgNDeleted: XM.MsgKey = keySCMsgAlIDeleted + l; 

keySCMsgMakeDocInProgress: XM.MsgKey = keySCMsgNDeleted + l; 

keySCMsgMakeDocComplete: XM,MsgKey = keySCMsgMakeDocInProgress + 1; 

keySCMsgSelectALexicon: XM.MsgKey = keySCMsgMakeDocComplete + l: 

keySCMsgLexiconlsEmpty: XM.MsgKey = keySCMsgSelectALexicon *■ 1; 

keySCMsgCantOpenLexicon: XM.MsgKey = keySCMsgLexiconlsEmpty + 1; 

keySCMsgAlternativesWordTooLong: XM.MsgKey = keySCMsgCantOpenLexicon + 1; 

keySCMsgUnknownError: XM.MsgKey = keySCMsgAlternativesWordTooLong 1; 

keySCMsgUnimp!emented: XM.MsgKey = keySCMsgUnknownError + t; 

keySCLexicon: XM.MsgKey = keySCMsgUnimplemented + I: 

keySCMsgReadOnlyAccess: XM.MsgKey = keySCLexicon + 1; 

keySCMsgConfirm: XM.MsgKey = keySCMsgReadOnlyAccess *- 1; 

keySCMsgCancel: XM.MsgKey = keySCMsgConfirm + 1; 

keyl.astMsgKey: CARDINAL = keySCMsgCancel: 


GetHandle: PROCEDURE RETURNS[h: XM.Handle]; 
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end. .. 


LOG 

7-Dec-84 - Marks - Create. 

9-Mar-85 10:16:01 - Marks - Updates. 

31-Jul-85 15:04:50 - Marks - AR17732: Add keySCMsgConfirm and keySCMsgCancel. 
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-- Mle: Spe11IngCheckerMessagelmpI.mesa - last edit: 

Marks.ES 31-Jul-85 15:21:34 

-- Owner: Document Group 


DIRECTORY 

Spel1ingCheckerMessageDefs, 

XMessage USING [A1locateMessages. DestroyMsgsProc, Handle. MsgEntry. RegisterMessages], 
XStrlng USING [FromSTRING]; 

Spel1IngCheckerMessagelmp1: PROGRAM 
IMPORTS XMessage, XStrlng 
EiX PORTS SpellingCheckerMessageDefs = BEGIN 
OPEN Spel1ingCheckerMessageDefs; 


h: XMessage.Handle <- NIL; 

GetHandle: PUBLIC PROCEDURE RETURNS [XMessage.HandleJ = [RETURN[h]}: 

DeleteMessages: XMessage.DestroyMsgsProc = {}; 

-- keyFindAlreadyOpen and keyNeedDocTextSelection are not used in OS5. 

1 nit: PROCEDURE = [ 

msgArray: ARRAY MsgKey OF XMessage .MsgEntry «- [ 

-- Messages with ’key' are posted in herald. Other messages appear in the property sheet. 
scTitle: [ 

msgKey: keySCTitle, 

msg: XString.FromSTRING[”Spe11ing Checker"L], 
translatable: TRUE, 
type: pSheetltem, 
id: 0], 

ScLookUp: [ 

msgKey: keySCLookUp. 
msg: XString.FromSTRING["look Up"L], 
translatable: TRUE, 
type: pSheetltem, 
id: 1 |. 
scEdit: [ 

msgKey: keySCEdit, 
msg: XString.FromSrRING["Edit"L ], 
translatable: TRUE, 
type: pSheetltem. 
id: 2], 
scScope: [ 

msgKey: keySCScope, 
msg: XString.FromSTRING["Check"L]. 
translatable: TRUE, 
type: pSheetltem, 
id: 3], 
scAHText: [ 

msgKey: keySCAHText, 

msg: XStrlng.FromSTRING["All text"L], 

translatable: TRUE, 

type: pSheetltem, 

id: 4], 

scRemainingText: [ 

msgKey: keySCRemainingText, 

msg: XString.FromSTRING["Remaining text"L], 

translatable: TRUE, 

type: pSheetltem, 

id: 5], 

scSelectedText; [ 
msgKey: keySCSelectedText, 
msg: XString.FromSTRING["Selected text"L], 
translatable: TRUE, 
type: pSheetltem. 
id: 6], 

scMisspelling: [ 

msgKey: keySCMIsspelling. 

msg: XString.FromSTRING["Mlsspelling:"L], 

translatable: TRUE, 

type: pSheetltem, 

id: 7], 

scCorrection: [ 

msgKey: keySCCorrection, 

msg: XString.FromSTRING["Correction"L]. 

translatable: TRUE, 

type: pSheetltem. 

id: 8], 

scChecKFrames: [ 

msgKey: keySCCheckFrames. 

msg: XString . Fro»nSTRING["Include Frames"L], 

translatable: TRUE, 

type: pSheetltem, 

id: 9], 

scAutoCorrect: [ 

msgKey: keySCAutoCorrect, 

msg: XString.FromSTRING["Auto-Correct"L]. 

translatable: TRUE, 

type: pSheetltem, 

id: 10]i 

scAmerEngLexicon: [ 

msgKey: keySCAmerEngLexicon, 

msg: XString.FromSTRING["American English"L], 

translatable: TRUE, 

id: 11]. 
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scEmptyLexicon: [ 

msgKey: keySCEmptyLexicon, 

msg: XString.FromSTHING[”Empty Dietionary"L], 
translatable: TRUE, 
id: 12], 
scClose: [ 

msgKey: keySCClose, 
msg: XString.FromSTRING["Close"L], 
translatable: TRUE, 
id: 13], 
scStart: [ 

msgKey: keySCStart, 
msg: XString.FromSTRING["Start"L], 
translatable: TRUE, 
id: 14], 
scContlnue: [ 

msgKey: keySCContinue, 

msg: XString.FromSTRING["Continue"l], 

translatable: TRUE, 

id: 15], 

ScCorrect: [ 

msgKey: keySCCorrect, 

msg: XString.FromSTRING["Correct"L], 

translatable: TRUE, 

id: 16], 

-- The following are option sheet specific 
scAddWords: [ 

msgKey: keySCAddWords, 
msg: XString.FromSTRING["Add"L], 
translatable: TRUE, 
type: pSheetltem, 
id: 17], 
scIgnoreWord: [ 

msgKey: keySCIgnoreWord, 

msg : XStr i ng . FromSTRING[ “ Ignore"L] , 

translatable: TRUE. 

type: pSheetltem, 

id: 18], 

scBatchCheckAndAdd: [ 

msgKey: keySCBatchCheckAndAdd, 
msg: XString.FromSTRING["Batch Check & Add"L], 
translatable: TRUE, 
type: pSheetltem, 
id: 19], 
scDeleteWord: [ 

msgKey: keySCDeleteWord, 

msg: XString.FromSTRING["Delete"L], 

translatable: TRUE, 

type: pSheetltem, 

id: 20], 

scMakeDocument: [ 

msgKey: keySCMakeDocument, 

msg: XString.FromSTRING["Make Document"L], 

translatable: TRUE. 

type: pSheetltem, 

id: 21], 

scMoveWindow: Q 

msgKey: keySCMoveWindow, 

msg: XString.FromSrRING["Move Window"L], 

translatable: TRUE, 

type: pSheetltem, 

id: 22], 

scWordsListedlnDoc: [ 

msgKey: keySCWordsListedlnDoc. 
msg: XString.FromSTRING["words"L], 
translatable: TRUE, 
type: pSheetltem, 
id: 23], 

scNoAlternatives: [ 

msgKey: keySCNoAlternatives, 
msg: XString.FromSTRING["???"L], 
translatable: TRUE, 
id: 24], 

scLexiconFolder: [ 

msgKey: keySCLexiconFolder, 

msg: XString.FromSTRING["Spel1ing Checker Dictionaries"L], 
translatable: TRUE, 
type: pSheetltem, 
id: 25], 

scConvertLexicons: [ 

msgKey : keySCConvertLexicons, 

msg: XString.FromSTRING["Convert Dictionaries"!-], 
translatable: TRUE, 
type: pSheetltem, 
id: 26], 

scMsgSpe11IngCheckerAlreadyActive: [ 

msgKey: keySCMsgSpel1ingCheckerAlreadyActive , 

msg: XString.FromSTRING["The Spelling Checker is already open."L], 
translatable: TRUE, 
id: 27], 

scMsgNeedAppropriateSelection: [ 

msgKey: keySCMsgNeedAppropriateSelection. 

msg: XString.FromSTRING["Can’t Start: select document text first."L], 
translatable: TRUE. 
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id: 28], 

scMsgCheckingSpel1ing: [ 

msgKey: keySCMsgCheckingSpel1ing, 

rasg: XString .FromSTRING[ ”Checkirtg spelling .. ." L ] , 

translatable: TRUE, 

id: 29], 

scMsgCheckingComplete: [ 

msgKey: keySCMsgCheckingComp!ete. 

ntsg: XString.From$TRING["Done. Words processed: ”L], 
translatable: TRUE, 
id: 30], 

scMsgUserCancelled: [ 

msgKey: keySCMsgUserCancelled, 

msg: XString.FromSTRING["Cancelled. Words processed: "L], 
translatable: TRUE, 
id: 31], 

scMsgMustlogln: [ 

msgKey: keySCMsgMustLogln, 

msg: XString.FromSTRING["Please log in first."L], 
translatable: TRUE, 
id: 32], 

scMsgBatchAddlngWords: [ 

msgKey: keySCMsgBatchAddingWo rds, 

msg: XString.FromSTRING["Checking/adding words to Edit dictionaries..,"L], 
translatable: TRUE, 
id: 33], 

scMsgConfirmBatchAddWords: [ 

msgKey: keySCMsgConfirmBatchAddWords, 

msg: XString.FromSTRING["P1ease confirm batch Add operation: "L], 
translatable: TRUE, 
id: 34], 

scMsgConfirmDeleteAlIWords: [ 

msgKey: keySCMsgConfirrnDeleteAl IWords , 

msg: XString,FromSTRING["Please confirm deleting all words in Edit dictionaries: "L], 
translatable: TRUE, 
id: 35], 

scMsgNoEditLexiconsSpecified: [ 

msgKey: keySCMsgNoEditlexiconsSpecified, 

msg: XString.FromSTRING[”Can't edit: No Edit dictionaries specified."L], 
translatable: TRUE, 
id: 36], 

scMsgNoLookUpLexiconsSpec Ified: [ 

msgKey: keySCMsgNolookUptexiconsSpecified, 

msg: XString.FromSTRING["No Look Up dictionaries spec ified.”L], 
translatable: TRUE, 
id: 37], 

scMsgConfirmEditLexiconlsFull: [ 

msgKey: keySCMsgConfirmEditLexiconlsFu11 , 

msg: XString, Frt>mSTRING[”An Edit dictionary is full. Do you wish to cont inue?"L], 
translatable: TRUE, 
id: 38], 

scMsgConf1rmLexIconCantBeOpened: [ 

msgKey: keySCMsgConfirmlexiconCantBeOpened, 

msg: XString.FromSTRlNG["A dictionary can't be opened. Do you wish to continue?"L], 
translatable: TRUE, 
id: 39], 

scMsgCorrectionListlsFul 1: [ 

msgKey: keySCMsgCorrectionLIstlsFul1, 

msg: XString.FromSTRING["Can't Auto-Correct that word: "L], 
translatable: TRUE, 
id: 40], 

scMsglgnoreListlsFul1: [ 

msgKey: keySCMsglgnoreListlsFul 1, 

msg: XString.FromSTRING["Can't Ignore that word: "L], 
translatable: TRUE, 
id: 41] , 

scMsgCantlgnoreMultipleWords: [ 

msgKey: keySCMsgCantlgnoreMultipleWords. 

msg: XString.FromSTRING["Can't Ignore those words: "L], 

translatable: TRUE, 

id: 42], 

scMsgUserEdltedDocCantCorrect: [ 

msgKey: keySCMsgUserEditedDocCantCorrect. 

msg: XString.FromSTRING["Can't Correct: the document has been edited."L], 
translatable: TRUE, 
id: 43], 

scMsgUserEditedDocCantContinue: [ 

msgKey: keySCMsgUserEditedDocCantContinue, 

msg: XString.FromSTRING["Can't Continue: the document has been edited."L], 
translatable: TRUE, 
id: 44], 

scMsgNoWordToCorrect: [ 

msgKey: keySCMsgNoWordToCorrect, 

msg: XString,FromSTRING["Can*t Correct: no source word to change."LJ, 
translatable: TRUE, 
id: 45J. 

scMsgCorrectionTooLong: [ 

msgKey: keySCMsgCorrectionTooLong, 

msg: XString.FromSTRING["Can’t Correct: Correction field is too long."L], 
translatable: TRUE, 
id : 46], 

scMsgConfirmCorrectionWasntApplied : [ 

msgKey: keySCMsgConfirmCorrectionWasntApplied, 

msg: XString.FromSTRING["The Correction field was changed but not the document. Do you wish to continue: "L], 
translatable: TRUE, 
id: 47], 

scMsgCantAutoCorrectCaseChange: [ - 
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msgKey: keySCMsgCantAutoCorrectCaseChange. 

msg: XString.FromSTRING["Can't Auto-Correct that word: the case change is insignificant."L], 
translatable: TRUE, 
id: 48], 

scMsgCorrectionWasntChanged: [ 

msgKey: keySCMsgCorrectlonWasntChanged. 

msg: XString.FromSTRING["Can't Correct: The spelling or case of the Correction wasn't changed."Lj, 
translatable: TRUE, 
id: 49], 
scMsgNAdded: [ 

msgKey: keySCMsgMAdded, 

msg: XString.FromSTRING["Done. Words added: "L], 
translatable: TRUE, 
id: 50], 

scMsgAllOeleted: [ 

msgKey: keySCMsgAllDeleted, 

msg: XString.FromSTRING["Oone. Deleted all words in Edit dictionaries."L], 
translatable: TRUE, 
id: 51], 

scMsgNDeleted: [ 

msgKey: keySCMsgNDeleted, 

msg: XString.FromSTRING["Done. Words deleted: ”L], 
translatable: TRUE, 
id: 52], 

scMsgMakeDocInProgress: [ 

msgKey: keySCMsgMakeDocInProgress, 

msg: XString.FromSTRING["Creating document for user-dictionary . .."L], 
translatable: TRUE, 
id: 53], 

scMsgMakeDocComplete: [ 

msgKey: keySCMsgMakeDocComplete, 

msg: XString.FromSTRING["Make Document operation completed."L], 
translatable: TRUE, 
id: 54], 

scMsgSelectALexicon; [ 

msgKey: keySCMsgSelectALexicon, 

msg: XString.FromSTRING["Can't Make Document: First select a private dictionary."L], 
translatable: TRUE, 
id: 55] , 

ScMsgLexiconlsEmpty: [ 

msgKey: keySCMsgLexiconlsEmpty, 

msg: XString.FromSTRING["That dictionary is empty; Make Document operation cancel led."L], 
translatable: TRUE, 
id: 56], 

scMsgCantOpenLexicon: [ 

msgKey: keySCMsgCantOpenLexicon. 

msg: XString.FromSTRING["Can't open that dictionary; Make Document operation cancel 1ed."L], 
translatable: TRUE, 
id: 57], 

scMsgAlternativesWordTooLong: [ 

msgKey: keySCMsgA1ternativesWordTooLong, 
msg: XString.FromSTRING["That word is too long.'L], 
translatable: TRUE, 
id: 58], 

scMsgUnknownError: [ 

msgKey: keySCMsgUnknownError, 

msg: XString.FromSTRING["Unknown Spelling Checker error.,,"L], 
translatable: TRUE, 
id: 59], 

scMsgUnimplemented: [ 

msgKey: keySCMsgUnimplemented, 

msg: XString.FromSTRING["That function is not currently available."L], 
translatable: TRUE, 
id: 60], 
scLexicon: [ 

msgKey: keySCLexicon, 

msg: XString.FromSTRING["Spen ing Checker Lexicon"L], 
id: 61], 

scMsgReadOnlyAccess: [ 

msgKey: keySCMsgReadOnlyAccess, 

msg: XString.FromSTRING["Must be in edit mode when making corrections."L], 
id: 62], 
scMsgConfirm: [ 

msgKey: keySCMsgConfirm, 
msg: XString.FromSTRING["Confirm"], 
id: 63], 
scMsgCancel: [ 

msgKey: keySCMsgCancel , 

msg: XString.FromSTRING[ ,, Cance!"] , 

id: 64] 

]; 

h «- XMessage.AllocateMes$ages[ 

applicationName: "Spelling Checker"L, 
maxMessages: MsgKey.LAST,ORD,SUCC, 
clientData: NIL, 
proc: DeleteMessages]: 

XMessage.RegisterMessagesf 
h: h, 

messages: LOOPHOLE[LONG[DESCRIPTOR[msgArray]]], 
stringBodiesAreReal: FALSE]}; 

lnit[]; 

END. . . 
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LOG (date - person - action) 

9-Mar-85 10:23:56 - Marks - Create 

3l-Jul-85 15:08:15 - Marks - AR17732: Add keySCMsgConf1rm and keySCMsgCanceI: AR15410: keySCMsgConf irmCorrectionWasntApplied changed to 
be understandable. 
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,ast 

-- Copyright (C, 1985 by Xero* Corporation. A„ rights reserved. 
directory 

Catalog USING [Open], JJ 

Heap USING [systemZone], 

■ ^u;HHsS ? Sdr°%? ? " 9 " etReferSnCe ' Ha " dle ' nUl ’ Hand,e ' " Ul1Refere - e ' OpenByRoference. Reference], 
Spel 1 i ngCheckerMessageDef s 9 ^ 3 Ue ' Ge ‘ w -^tati„„Prof i , 8] . 

m“nTUHM . M. 9 0 ^.i wJ . 

SP TMmS?Q f ’» Ck ^ rMS9Fi1eImpl : PR 0GRflM 

EXPORTS SpelHngCheckerMessageDefs’ = Hpap • NSFile. NSString. OptionFile, XMessage, XString 
-- Data 


h: XMessage.Handle r NIL; 

'ocalZone; UNCOUNTED ZONE - Heap.systemZone: 

- Procedures 

De leteMessages; PROCEDURE [cM.ntD.tai XMessage.C, ientDataj , [} . 

GPEOandle: PUBLIC PROCEDURE RETURNS [XMessage. Hand , e ] - (RETURN^): 
IniUtessages; PROCEDURF - { 

["Spellt^ Checker"L]; 

XMe$ ^|:9 e - Mes sagesFromReferente [ 

e NentO^^r ' eRef [^»c.t1o.F..d.r‘rro-l.. [0interna ,Na„,e]]. 
proc: DeleteMessages J; 
h * msgDomalnsfO].handle: 

XMessage.FreeMsgDoma1nsStorage [msgDomainjj; 

'T^T^g^ NSFile.Reference] 

FindMessageFileFromName: PROCEDURE rvalue- XStrinn h i 

nssName: NSStrinn Strinn <. vet • L xs > trin 9 • Reader] = f 

fr: va,ue> 

msgFileHandle <- NSFile nnd r!] 0 na " e haS an a3ter1sk in it. 

IF nisgFileHandle - HSFi’le.nunHwSlI PH^N ’ Irrqr • Ha " d ‘ ® ' C ° NnNUE » ; 

tms9Fi,0 “' - — — 

NSString.Freestri„g [z: locaizone. s: nssNa.e]; 

IF _^°M der = NSFile.nuliReference THEN [ 

folderHandle <- Cata1og e open°[BWSFHeTvoes e s st^f 0 ? r° d the Workstat 1onProfile 

EL adf { r Opti„„Fi 1 e.Get W o^ k LtWronle yP []V ySte "' F,leCatalo9j : 

folderHandle e NSMle^OpenByReference 0 )]folder]. ’ d6r and the adf i" 3 ^ it- 

calIBack: F 1 ndMessageFileFromName, 

File: adf]; 

NSFile.Close [folderHandle]; 


localZone]; 


Mainiine code 
InitMe*5sages[]; 


LOG 

l-May-85 10:40:54 


Marks - Create. 
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:: task 

- «•«£* ts;s 




DIRECTORY 

SW k n f ti0 " i! S n WG [Clear ' Post ’ p °stAndConfirm] 

l.ursor USING [Set] nomanj, 

nl C m ,e ?n D f S USING'[DocFromlzn, Handle] 

OocWindowOef s^(JSING G [MakeCaretV1s ib^e] Gk ' f ' reeS * ste ' ,,0 ° c • LockSystemDoc], 

GetNormalizedword]?' Lex lconHa,,d 1 e ■ Lex 1c onIsFul 1 , Lexicons. LookUpWord, 
jfroductFactoring USING [Enabled] 

SchemaDefs USING [Lschema. IschemaNil]. 

Spe11ingCheckerDefs USING [ 

LookUpInPai rL i s t^nBytesLongestWord CC Reo? et ^^ ^ V6l "^ X ’ cons • Items. 

ScopeFromChoice, SCScanCtxt sptfwr + P aceStartWi thContinue, 

StartAlternativesGeneration * ???° ntext ' Sa «>ocNotEd 1 ted, 

UpdateWordCountDisplay, Use^Edi?edDoc]?'“^''" esGenerat ^I 0 "• 

Spe ! I ingCheckerMessageDefs USING [ 

FeySCMsgNAdded^keySCMsqNDeieted^ f k W °SG S ’ keySCMs 9 A 1 'Deleted , 
keySCMsgConf i rm . keySCMsgCance 1 'kovSnSs’T p "/' ™ Ed 1tL6X 1 conI sFu ' n ■ 

keySCMsgNeedAppropMateSe lection kevSCM *r f ex ,consSpec if led. 
keySCMsgBatchAddingWords? keisCMsoiserCance?? a rm s atChflddWords ’ 
FeySCMsgUserEditedDocCan Continue L u crl®rH ;. keySCMs9Unkno ™ Err «''- 
keySCMsgChecki ngCompl ete. “ey^^gcSnSnfoS^dnlf 1 ’ in9 ■ 

: ^UU^?ruSING G [ [StarSPe111 "^’ 

np A USING N [UsorAbort] i;XtSe9n ' ent ' Rdr • Te * tSegmentFromXString] . 

mOetTu°s[N G U m G £ C ° pyB I° dkadd r. Ha.Blocc.ddr], 
rxt£dItDe?s Ssf N B G°[ kaddr - Se,desc ' I-«e g „,ent. 'textSegmentNi 1 ]. 

T tFd^V 0 yTe *^ P ^' 0 ^ d “^ tCRa P' a «wnhstMna 0 P fm tSesmen ^ CreateSe,d «c. 

1 ushEnumFPomSeTectton ta Readonl'vWordF? E ~~- 

WiOEN WordFlagsObject, WordProc, Wo rdScanCUtOble ’ t Bca " Words • TokenProc. 
UserTernnnal USING [BeepJ a^canotxtOb ject ]. 

L “«' Mak ^ UPPe-Case], 

XMessage USING [Get, Handle] 

XString USING [ 

Gereference, emptyContext^First Ch F?eeR 6r I; e,1 R th ' CopyroNewW riterBody, 

Insuf f ‘cientRoom .^NewWri terBodyl* nuHReaderBody 65 

x , ^rr s s?*r ,pFr, * p,t ' r - 

Spe !.l™2 CheckerSGanPack; PROGRAM 
IMPORTS 

Soc t S?„ t d^e?] 0C ?. F ^;^d i S! , ',-J :harD rT CurSOr ' D ° p ™efs 
Spel l ingCheckerDefs Spell' inorheT^ ' PrpddapPa ctoring, 

TxtEditExtralOefs. TxtScanDefs. ^xt r utHDe?s 6f Use^ P ' TxtBlockDefs - TxtEditDefs. 
XMessage. XString luuluet s. UserrerminaI. XChar. 

J S c Spe ' 11 n 9Cben ke rDef S 
shares SchemaDefs. XStrlna = 

BEGIN y 

0 PE i::imgcrk d ?Mes^sr: fs n? pe ;ii^? ds i er ? efs ' 

TextUtilOefs, XM: xs:'xst“n 3 r T * ' 

fjug: SIGNAL [Bugtype] = CODE; 
ugtype; TYPE = [impossible, unimplemented}; 

--TYPES 
-- CONSTANTS 

h ' XMJIandle ' SpellingCheckerMessageQefs,GetHandle[]; 

-- VARIABLES 

■byZone: UNCOUNTED ZONE e NIL; 

- - PROCEDURES 

temp to avoid 'from' being normalized 
AppendReader: PROC [to; XS.Writer, Pnom; XS.Reade, extra; CARDINAL * 0 ] . 

rb: XS.ReaderBody - XS.Dereference[from]; 


DocUtmiefs, 
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XS.AppendReaderfto: to, from: @rb, extra: extra]; 


ResetWriter: PROC [w: XS.Writer] 
IF w # NIL THEN { 

w.context «- w.endContext «■ 

}: 


= C 

XS,emptyContext; w.offset 


w.1Imit 0 ; } ; 


AddOrOeleteWords: PUBLIC PROC [addOrDelete: AddOrDeletel = f 
OPEN c: checkCtxt; 
nAddedOrOeleted: CARDINAL «■ 0; 

edit: LexiconDefs.Lex Icons = GetActiveLexicons[].edit; 
tsBlock: TextSegment; 
string: XString.ReaderBody; 

IsTeropNorm: LONG STRING = [nBytesLongestWord]; 
normal izedWord: XS.WriterBody <- XS.Wri terBodyFromSTRlNG[ 
s: IsTenipNorm, homogeneous: TRUE]; 
nWord: XS.Reader = Rdr[@normalizedWord] ; 
tooLong: BOOL «■ FALSE; 


XM.Get[h, keySCMsgConfirmEditLexiconlsFul1]; 


AddOrDeleteProc: TxtScanOefs .WordProc *' { 

scMsgConflrmEditLexiconlsFul 1 : XS .ReaderBody 
status *■ done; 

LexiconDefs.GetNormalizedWord[ 

word, wordFlags, ^normalizedWord ! 

XS.InsufficientRoom => GOTO tooLong]; 

IF addOrDelete = add THEN { 

IF LexiconDefs.AddWord[ 
edit, nWord, wordFlags f 
LexiconDefs.LexiconlsFul1 => 

IF Attention . PostAndConf i rm[@scMsgConfi rmEditLex iconlsFul 1 ]. confirmed THEN 
RESUME 

ELSE (status - abort: CONTINUE]]. addedToAny 
I HEN 

nAddedOrOeleted - nAddedOrOeleted + 1 ; 


ELSE ( 

IF LexiconDefs.DeleteWord[edit, nWord, wordFlags].deletedFromAny THEN 
nAddedOrDeleted <- nAddedOrOeleted + i; 

}: 

EXITS tooLong => tooLong <- TRUE; 

}--AddOrDeleteProc 


IF edit - NIL THEN ( 

scMsgNoEditLexiconsSpecified: XS.ReaderBody XM.Get[ 
h, keySCMsgNoEditLexiconsSpecified]: 

Attention.Post[@scMsgNoEditLexiconsSpec i fled]; RETURN; }; 

IF addOrDelete - delete THEN { --first check for '* 
rb; XS.ReaderBody «■ FormWindow.GetTextItemValue[ 
c.fw, Items.correction.ORD. myZone]: 


IF (XS.CharacterLength[@rb] - l) 

AND (XS.First[@rb] = LQOPHOLE[CharDefs.RomanfasteriskJ, XS.Character]) 
THEN ( 

scMsgConfirmOeleteAl 1 Words: XS.ReaderBody <- XM.Get[ 
h, keySCMsgConf irmDeleteAHWords]; 
scMsgConfi rm : XS.ReaderBody - XM.Get[h. keySCMsgConf i™]; 
scMsgCancel: XS.ReaderBody <- XM.Get[h, keySCMsgCanceIJ; 

--it's an * 


IF Attention.PostAndConfirm[s: SscMsgConfirmDeleteAlIWcrds, confirmChoices: 
THEN { 

scMsgAllDeleted; XS.ReaderBody «- XM.Getfh, keySCMsgAUDeleted]; 
wordFlags: TxtScanDefs.WordFlagsObject; 
wordFlags .nChars «- LAST[CARDINAL] ; 

[] «- LexiconDefs .DeleteWordfedit, NIL, ©wordFlags]; 
c . inval idAltList TRUE: 

UpdateWordCountDisplay[checkCtxt]: 

AttentIon.Post[@scMsgAllDeleted]; 


XS.FreeReaderBytes[@rb. myZonel: 
RETURN; 

} --its an * 

ELSE XS.FreeReaderBytes[@rb, myZone]; 
}; --addOrDelete = delete 


[©scMsgConfirm. GscMsgCance I ]].confirmed 


string *- FormWindow .GetTextltemVal ue[c . fw , I terns . correct ion .ORD , myZone]; 

<< The scratchBlock was created in the SystemDoc by 

Spell ingCheckerWnPack.Init. Since the block resides in the SystemDoc. 
we must prohibit every other editing action in that doc until we're 
through. >> 

DocUtiIDefs.LoekSystemDoc[]; 

(ENABLE UNWIND => OocUtiIDefs.FreeSystemDocf]; 

tsBlock <- TextUtilDefs.TextSegmentFromXString[@string, c. scratchBlockl 
IF tsBlock ft textSegmentNil THEN ( 

normal izedWord.offset «• normal izedWord . 1 imit «■ 0; 

[] «- TxtScanDefs .ScanWordsf 

range: tsBlock, wordProc: AddOrDeleteProc, 
nBytesLongestWord: nBytesLongestWord + 3 , 

--allow extra 3 here so that we can detect when a word is present which is too lonq (and reject it) 
zone: c.zone]; 3 v J ’ 

TxtEditDefs.DestroyTextSegment[@tsBlock]; 

}| -- ENABLE 

DocUtiIDef$.FreeSystemDoc[]: 

IF nAddedOrDeleted > 0 THEN ( 

UpdateWordCountDIsplay[checkCtxt] ; c . inval idAltList <- TRUE: }: 


? 
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IF (tooLong AND (nAddedOrDeleted = 0)) THEN { 

scMsgCorrectionTooLong: XS.ReaderBody <- XM.Get[h, keySCMsgCorrectionTooLong]; 

Attention,Post[@scMsgCorrectionTooLong] 

} 

ELSE { 

wb : XS .Wri terBody *• XS .NewWriterBody[40 . c.zone]; 
r** XS Reader• 

message: XS.ReaderBody <- XM.Get[h, (IF addOrOeletc - add THEN keySCMsgNAdded ELSE keySCMsgNDeleted)]; 
XS.AppendReader[©wb, ©message]; 

TextUti1Defs.AppendNumber[ 

©wb, LONG[INTEGER[nAddedOrDe1eted]], XFormat.Decimal Format]; 
r *■ XS.ReaderFromWr1ter[@wb]; 

Attention.Post[r]; 

XS.F reeWriterBytes[©wb]: 

}; -- AddOrDeleteWords 

ScanBatchCheckAndAdd: PUBLIC PROC [lookup, edit: LexiconDefs.Lexicons] = { 

OPEN c: checkCtxt; 

nProcessed, nAdded; CARDINAL «- 0; 

enumStatus: EnumStatus; 

sc: FxtScanDefs.WordScanCtxtObject; 

IsTemp: LONG STRING = [nBytesLongestWord]: 

I sTempNorni: LONG STRING = [nBytesLongestWord + 3]: 
normal izedWo rd: XS.Wri terBody «- XS.WriterBodyFromSTRING[ 
s: IsTempNorm, homogeneous: TRUE]; 
nWord: XS.Reader = Rdr[@norma1izedWord]; 

includeFrames : BOOLEAN *■ FW.GetBooleanltemVa lue[c . fw. I terns .checkFrames .ORD] ; 
tokenProc: TokenProc = { 

scMsgConfirmEditLexiconlsFul 1: XS.ReaderBody «- XM.Get[ 
h , keySCMsgConfirmEditLexiconlsFul1 ] • 

IF TIP,LJserAbort[c. swsj FHEN GOTO aborted: 

Will! tk: token SELECT FROM 
word -> { 

LexiconDefs.GetNormalizedWord[tk.sWord. tk.wordFIags, ©normalizedWord]; 
nProcessed *• nProcessed + 1; 

IF lookup = NIL 

OR -LexiconDefs.LookUpWord[1ookUp , nWord. tk .wordFlags].found 
THEN { 

[] <- LexiconDef s. AddWord[edit. nWord, tk.wordFlags !LexiconDefs.LexiconlsFul1 => 

IF Attention.PostAndConfirm[@scMsgConfirmEditLexiconlsFul1].confirmed THEN 
RESUME 

ELSE GOTO aborted: 

]: 

nAdded *■ nAdded +■ 1; 

}: 

}: 

ENDCASE; 

EXITS aborted => status *■ abort: 

}; --tokenProc 


sc *■ [ 

scanCtxtObject: [ 

textEnum: TxtScanDef s.EnumerateWords , 
tokenProc: tokenProc, z: c.zone, 
includeAnchoredFnames: includeFrames . 
includeCaptions : IncludeFrames] , 
word: XS.WriterBodyFromSTRING[s: IsTemp, homogeneous: TRUEjJ: 

IF FxtScanDefs.PushEnumFromSelection[ 
sc: WIDEN[Qsc], 

scope: ScopeFromChoice[FW.GetChoiceItemValue[c.fw. Items.scope.ORD]]].doc 
= NIL THEN { . 

scMsgNeedAppropriates©lection: XS.ReaderBody XM.Get[h. keySCMsgNeedAppropriateSelection]; 
Attention.Post[©scMsgNeedApproprlateSelection]; 

RETURN; }; 

scMsgConfirmBatchAddWords: XS.ReaderBody «• XM.Get[h, keySCMsgConfirmBatchAddWords]; 

IF -Attention.PostAndConfirm[@scMsgConfirmBatchAddWords].confIrmed 
THEN {PopAI1Enum[WIDEN[@sc]]; RETURN: }: 

}; 

--ok, nothing else to go wrong... 

Cursor.Set[hourGlass]: 

[scMsgBatchAddingWords: XS.ReaderBody «• XM.Get[h, keySCMsgBatchAddingWords]; 

Attention.Post[@scMsgBatchAddingWords]; 

StopAlternativesGeneration[]; 

normal izedWord.offset *- normal izedWord , 1 iroit *■ 0; 
enumStatus *- TxtScanDef s . EnumerateStack[WIDEN[@sc]]: 

IF nAdded > 0 THEN UpdateWordCountDisplay[checkCtxt]; 

wb : XS.Wr iterBody «■ XS.NewWriterBody[40, c.zone]; 
r: XS.Reader; 

SELECT enumStatus FROM 
done => f 

scMsgCheckingComplete : XS.ReaderBody <- XM.Get[h, keySCMsgCheckingComplete]: 
XS.AppendReader[©wb, ©scMsgCheckingComplete]; 

}; 

abort => { 

scMsgUserCancel led: XS.ReaderBody «* XM.Get[h, keySCMsgUserCancelled]: 

XS.AppendReader[@wb, ©scMsgUserCancelled]; 

}: 
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ENDCASE; 

TextutiIDefs.AppendNumber[ 

@wb. LONG[INTEGER[nProces$edJ], XFormat.DecimaI Format 1 ; 
r *- XS.ReaderFromWriter[@wb]; 

Attention.Post[r]; 

XS.FreeWriterBytes[@wb]; 

Cursor.Set[textPointer]; 

}; --ScanBatchCheckAndAdd 

Startchecking: PUBLIC PROC [lookup: LexiconOefs.Lexicons I - f 
OPEN c: checkCtxt; 
doc: DocumentDefs.Handle; 
scSC: SCScanCtxt = @c.scScanCtxtObject: 

-- doc context must be nil already 
IF J 

(doc <- PushEnumFromSelectionr 
sc: WIDEN[scSC], 
scope: ScopeFromChoice[ 

FW.GetChoiceItemValue[c.fw. Items.scope.ORDjjJ.doc) = NIL THEN f 
scMsgNeedAppropriateSelection: XS.ReaderBody XM.GetT 
h, keySCMsgNeedAppropriateSelection] ; 

Attention.Post[@scMsgNeedAppropriateSelectionl • 

RETURN: 

}: 

SetDocContext[doc]; 
scSC . nProcessed «■ 0 ; 


WITH e; scSC.wordScanCtxtObject.scanCtxtObject.ee SELECT FROM 
text => scSC .wordScanCtx tObject. ts «• TxtEditDefs 
ENDCASE => ( 


opyTextSegmcntf@e .range]: 


ba, ba2: TxtDefs.B1ockaddr; 

doc: DocumentDefs . Handle «- DocumentDefs . DocFromI zn[ 

scSC.wordScanCtxtObject.scanCtxtObjoct.ec SELECT FROM 
graphicsFrame => e.frame.izn, 
table ~> e . tab 1eSchema.izn, 
illustratorFrame => e.frame, izn. 
frameCaptions => e.frame.Izn. 

ENDCASE => InstanceDefs.iznNi1 - shouldn't actually be using this -- ]• 

TxtBlocKOefs.WewBlockaddr[DocUtiIDefs.GetMeinlextChninBlockldoc. first! first! 
ba 2 e rxtBlockOefs .CopyBlockad'dr[baJ; J 

scSC.wordScanCtxtObject.ts <- [ba. ba 2 ]- 


WITH 


ba 


ReplaceStartWlthContinue[]; 

ScanUtl1[lookup]; 

ContinueChecklng: PUBLIC PROC [lookup: LexIconDefs.Lexicons 1 - f 
OPEN c: checkCtxt; 1 ' 

scSC: SCScanCtxt = @c.scScanCtxtObject; 

StopflIternativesGenerationf1; 

SELECT TRUE FROM 

(scSC.wordScanCtxtObject.scanCtxtObject.ee - NIL) => { 

sr.MsgUnknownError: XS.ReaderBody «■ XM.Get[h. keySCMsgUnknownErrorl ■ 
Attention,Post[@scMsgUnknown!rror 1 • 

RETURN}; 

UserEditedDocfc.doc] => [ 

scMsgUserEditedDocCantContinue: XS.ReaderBody «- XM.Get[ 
h. keySCMsgUserEditedDocCantContinue]; 

SetDocContext[NIL]; --replaces Continue cmd 
Attention.Post[@scMsgUserEditedDocCantContinuei 
RETURN; 

}: 

ENDCASE -> ScanUti1[1ookUp]; --ok to proceed 


-- interactive checking scan: 

ScanUti1: PROC [lookup: LexiconDefs.Lex icons 1 = f 
OPEN c: checkCtxt; 
enumStatus: EnumStatus; 
scSC: SCScanCtxt = @c.scScanCtxtObject: 
correction: XS.WriterBody; 
replaceWord: BOOL <- FALSE; 
txtCtxt: TxtEditDefs.AqTxtCtxt; 

blockLastWordReplaced; SchemaDefs.Lschema *■ SchemaDefs.1schemaNil• 

editsPending: BOOL <- FALSE!; 

nWord: XS.Reader = Rdr[@scSC.norma 1izedWord]; 

scMsgCheckingSpelling: XS.ReaderBody * XM.Get[h, keySCMsgCheckinoSpellinql; 
includeFranies: BOOLEAN *- FW.GetBoo 1 eanItemVa I ue[c. fw. Items.checkFrames.ORD]; 


HandleMisspel1ing: PROC = { 

StartAlternativesGeneration[ 
lookup, Rdr[@scSC.wordScanCtxtObject.word]. 

@scSC.wordScanCtxtObject.wordFlags]; 

Attention.Clear[]; 

SetDocNotEdited[c.doc]; 

SelectAndScroll[@scSC.wordScanCtxtObject.ts]; 

FW.SetTextltemValue[ 

c.fw. Items.misspel1ing.ORD, 

XS .ReaderF romWriter[GscSC.wordScanCtxtObject.word] 1 • 
FormWindow.SetTextltemValue[ 
c.fw. Items.correction.ORD, 
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XS.ReaderFromWriter[@scSC.wordScanCtxtObject.word] 1 ■ 

UserTernnnal.8eep[frequency: 300, duration : 200]; 

--remember current value to detect changes 
IF c.lastCorrectionValue # XS.nul1ReaderBody THEN 

XS FreeReaderBytes[0c.lastCorrectionValue. myZonel- 
c.lastCorrectionValue «• FormWindow.GetTextltemValuer 

c.fw, Items,correction.ORD, myZonej; 

}: 

ReplaceWord: PROC = { 

IF -editsPending THEN { 

TxtEditDefs,BeginEdit[0txtCtxt]; editsPending - TRUE' ) 

after e'.'cTb I’ock' a^wa/ ,f $ °' lndEd 1 t/Beg i nEdi t to prevent editing too many chains; it is more 

" ?x?Fdith d ? Ca ' C ’ C a^° bJ rr t ' b,0Ck # b '»^LastWordReplaced THEN f 

TxtEdltDefs.EndEdit[0txtCtxt]; TxtEditDefs.BeginEdit[0txtCtxt]; }; 

blockLastWordRepIaced :* scSC.wordScanCtxtObject.block; 

IF BlockFriendsDefs.InRedliningMode[] THEN 

TxtEditExtralDefs.ReplaceWithStringForRedlintnqr 

GtxtCtxt, GscSC.wordScanCtxtObject.ts, 

XS.ReaderF romWr i ter[@correction]]; 

XS.F reeWrlterBytes[@correcti onj; 


tokenProc: TokenProc = { 

WITH tk: token SELECT FROM 
word => { 

found: BOOL; 

IF TIP.UserAbort[c.swsJ THEN RETURN[status: abort |; 

LexiconDefs.GetNormalizedWord[ 

tk.sWord, tk.wordFlags, GscSC.normalizedWord1• 
scSC. nProcessed <- scSC . nProcessed \ ■ 

irtu^Err f ~:no°rrr c ' ookup: 

ignored: ARRAY [0..1) OF Lex iconDefs . Lex iconHandle <- f 
c . IgnoreL i st] ; 

IF LexiconDefs .LookllpWord[ 

L E ?n!?,L PTOR[l9n0redl , nWord ' tk -«ordF lags], found THEN 
RET(JRN[status: done]; 

status «- pause; 

IF scSC.autoCorrect THEN { 
temp: XS.ReaderBody; 

tempFlags: TxtScanDefs.ReadonlyWordFlags: 

[found, temp. tempFlags] <- LookUpInPairListf 
list: c.correctionllst, word: nWord 
wordFlags: tk.wordF1ags I; 

IF found THEN { 

correction ♦- XS.CopyroNewWriterBody[@temp, c zone]* 

SetNewStringCaseFromOldWord[ 

oldWord: tk.sWord. oldWordFlags: tk.wordFlags 

™ P Srt 9 ; T 9 R c ur ect1on ' " ewStrin9na9s: 

} 

ELSE replaceWord FALSE; 

}; --IF scSC.autoCorrect 
}; -- IF ~found 

}: 

ENDCASE; 

}: -- tokenProc 

assign each time since It’s a local proc 

scSC.wordScanCtxtObject.scanCtxtObject.tokenProc *■ tokenProc; 

ClearllostDocCs[]; 

- unconditionally clear the cs if in the host doc 

- if auto ^ correcti "g- Td that cs isn't invalidated by edit 

surprise operation if St' ir^edJIteirbuggeTaga^fthJs'has hap^enedl^''''' ^ ab ° rt 0r d ° n8 ' “ 8 Want tc 
Attention.PostfGscMsgChecklngSpelling]; 

enumStatus «- TxtScanDefs. EnumerateStack[WIDEtJ[$cSC]] • 

ENDL00p"' StatUS = PaUSe> AN ° replaceWo, ’ d ™ EN ReplaceWord[] ELSE EXIT; 

IF editsPending THEN TxtEditDefs.EndEdit[@txtCtxt]• 

E | F s | !n y IT,StatL,S = pause THEN HandleMISspell ing[] 


wb: XS.WriterBody <- XS.NewWriterBodvr 40 
r: XS.Reader; 


c. zone]; 


all enumerators have been popped 
SetDocContext[NIL]; --replaces Continue cmd 


efficient to EndEdit 


this to avoid 
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keySCMsgUserCancelied]; 


IF enumStatus = abort THEN { 

scMsgUserCa nee lied: XS.ReaderBody <- XM.Getfh. 

XS.AppendReader[@wb, OscMsgUserCancelTed]; 

ELSE { 

X9 M Zi^i n 2 CO ?S 1 K te ^ X > S ' Reader Body - KM.Get[h. keySCMsgCheckingCon.plete I 
XS.AppendReader[@wb, OscMsgCheckingComplete]; J 

TextUtiIDefs.AppendNumber[ 

@ vc , D LONG [ INTEGER [ ScSCnP ro cesse d]] 1 ^Format.Decimal Format]; 
r *• XS.ReaderFromWriter[@wb]; 

Attention.Post[r]; 

XS.FreeWriterByte$[@wb]; 

--ScanUti1 


SelectAndScro11: PROC [ts: LptTextSegment] > ( 
seldescNew: TxtDefs.Seldesc; 


Set the selection and display pcoperly. 
seldescNew <- TxtEditDefs.CreateSeldescf 
TxtEditDefs.Se1 Description[ 

segment, segment[TxtEditDefs.CopytextSegment[ts]l]1: 

TxtEd i tOef s ,A1 terCurrentSelect ion[ seldescNew]': 

DocWindowDefs.MakeCaretVisible[percentFromLeft: 10 , percent!romTop: 10 ] : 


SetNewStringCaseFromOldWord: PROC [ 

oldWord: XS.Reader, oIdWordF 1 egs: TxtScanDefs.Readon1yWordF1aqs 
newStrmg: XS. Welter. newStringFlags: TxtScanOefs, Readon ! yWordFl aqs 1 . r 
newOffset: CARDINAL = newString.offset; ^ 

newBytes: XS.Bytes = newString.bytes: 


SetCaseOnNChars; PROC [ 

Start; CARDINAL «• 0, n; CARDINAL, case: {upper, lower}] = { 

chset; CharDefs.Chset *• newStr i ng . context. prefix • 

code: CharDefs.Code; 

xchar: XChar.Character; 

offset: CARDINAL «• newOffset: 

THROUGH [0..start) DO 

code «- newBytes[off set]; 

IF code = 377B THEN { 

chset «- newBytes[offset *■ l] : offset «■ offset + 3- I 
ELSE offset «■ offset + 1; ! 

ENDLOOP; 

THROUGH [0..n) DO 

code *• newBytesfoffset]; 

IF code = 377B THEN { 

chset «- newBytes[offset + l]; 
offset «• offset + 2; 
code «- newBytes[offset]; 

xchar «- XChar.Make [set: chset, code: code]: 
newBytes [off set] <- XChar. Code [ 

(IF case = upper THEN XChar.UpperCase[xchar] 

ELSE XChar.LowerCase[xchar]) ]; 
offset «- offset + I; 

ENDLOOP: 


SELECT OldWordFlags.case FROM 
allLower => 

SELECT newStringFlags.case FROM 
allLower => NULL; 

HrstCharUpperOnly -> SetCaseOnNCharsfn: 1 . case: lower]: 
allUpper »> SetCaseOnNChars[n: newStringFlags.nChars, case: lower] 
ENDCASE; --mixed case, leave new string as is 

firstCharUpperOnly => 

SELECT newStringFlags.case FROM 

allLower => SetCaseOnNChars[n: l. case: upper]; 
firstCharUpperOnly => NULL: 
allUpper =•> 

SetCaseOnNChars[ 

start: 1, n: newStringFlags.nChars 1. case: lower]; 

ENDCASE; --mixed case, leave new string as is 

allUpper => 

SELECT newStringFlags.case FROM 

allLower => SetCaseOnNChars[n: newStringFlags.nChars, case: upper!• 
firstCharUpperOnly => K 

SetCaseOnNChars[ 

start: 1, n: newStrlngFlags.nChars - 1, case: imperi¬ 
al lUpper => NULL; 

ENDCASE; --mixed case, leave new string as is 
ENDCASE; --mixed case, leave new string as is 


-- MAINLINE 

<< Initialize SC tool context If the SC is Installed in the product » 
II ProductFactoring.£nabled[StarPFOptlons.starspelling] THEN 
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BEGIN 


my Zone «- checkCtxt. zone; 

checkCtxt.scScanCtxtObject «• [ 
wordScanCtxtObject: [ 
scanCtxtObject: [ 

textEnum: TxtScanOefs.EnumerateWords, --never chanaes 
tokenProc: NIL, --set in Scanlnteractive 
z: checkCtxt.zone, 

cal 1TokenProcOnTi1es: FALSE], -never changes 

L 0 [?L X ?Rnn WrnerBOdyCn |! yteSLOn9eStWortl ' checkCtxt.zone], -never changes 
setis. I HUE J, -never changes - a 

normalizedWord: XS.NewWriterBody[nBytesLongestWord * 3, checkCtxt.zone] -never changes 
checkCtxt.scScanCtxtObject,wordScanCtxtObject.word,zone e NIL; - s0 that 1t ne , er automaticaIly grows 


END. 


SpellingCheckerScanPack 


27- Jun-84 
1-7-Jul -84 18:47:58 

28- Sep-84 9:12:52 
9-Mar“85 

12 Mar-85 


MakeCaretVisible now gets 10%. 


LOG (date - person - action) 

5-JUII-84 16:59:38 - Walden - 0S5.0 release version 1 
18:11:46 

WelH„ LeW ’r- I ie ization to FeatureDefs product factoring flag. 

Walden - Fix ScanUtil for AR 1144/ a 

10:21:43 - Marks - Update to OS6. 

21 -Mar-88 iginvai ~ !! ar i“ " !! ep ' ace R ea I ToReade rBody with Tex tu 111 Oef s. AppendReader 

-Apr- 5 : :iz: sss 1 ssrp^^;;' , ?«^: r ;:r rted from TxtEditDefs - not 

^ ES ' Co'ect^rprdoess^h^abort"^.^" 9 ^ & ^ 

not Ves/No!°' 2105 MarkS " AR1/73Z: When ^^ting all elements of lexicon and asking for confirmation cho ,ces should be Conf irm/Cancel 
2 q Anr-sr " Barblett " u5e LockSystemDoc, FreeSystemOoc 

Rep 1 aceWord, ScanBatchCheckAndAdd : Mnform C to B ne« h SCsSnCtnObje' t t rtCheC ^' 9 ' ContinueCheck1n 9 • ScanUtil, Handl eMi sspel 1 ing , 

, LeW ' S " Get u PP er/L °«rCase operators from XCharProps " 

HMavl? m^r^L ^^f^P'^'P^Upper/LowerCase now accessed through XChar. 

7-Aun 87 ~ m® 1 "^ " U „! e Block FriendsUofs instead of B TockPr , vE x tra IDef s . 

16-NOV--87 Ifi'ng.'nn " Mark! " ! -,1V 1 nc 1 bPcCapt i ons = i nc I udeAncho redF rames 

scSC.wordScanCtxtObject.ts in Sta?tChec!kl!!g der ^ a "° W ' nit se,e '' t101 ' t0 be a fra » le »«st use alternative method to allocate 
2-Dec 87 13:27:46 - Bartlett - add UNWIND call to FreeSystemOoc for AR 16204 
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File: Spel1ingCheckerUtiIPack.mesa - last edit’ 

- Walden 27-Mar-87 17:36:42 

- Maybury.ES 9-Apr-86 13:43:26 

Marks.ES 12-Sep-85 14:43:11 


copyright (C) 198S, 1986. 1987 by Xerox Corporation. All rights reserved. 


DIRECTORY 

AppIicationFolder USING [FlndDescriptionFile. FromNamel. 

BWSZone USING [shortLifetime], 

CharDefs USING [chsetRoman, Romany, 

DocInterchangeDefs USING [AppendNewParagraph, Appendrext. Doc. DocObject FinishCrealion iMrtrreatinni 
DocopecialDefs USING [ClearCIientsEditedFlag. EditedFlagID. GetClientsEditodFlaal ’ etion], 

DocumentDef $ USING [DocFromlzn . Handle ], teanag j , 

DocUtilDefs USING [subtypeBlankDoc], 

IlashTab 1 eLexiconDefs USING [fileType, Space InadequateCannotEnumerate I 
HashTableTempLexiconDefs USING [ 

OpenTemp, CloseTemp, AddTempWord, LookUpTempWord, Value, ValueFreeProrl 
WordProc]^ S USING CCreateLeXlCOn ' leAttrType, GetFiieAttrs. IsCurrent.' LexIconFi!eAttrs, LexiconHandle, LexiconlsFull, Lexicontype. 

Ex tendedAttributeTvnn te Fi^tor ib Goffltr^Hh. , ;+^i}^M™ aC '^^^FibuLesflecord.ChangeAttributes, ClearAttributes. Close, Delete. Error. 


nullHandle, nulIReference, OpenByReference 


Ref e rente ^Type ^Words ]^ 1 ^ te r ’ GetAttributesByName, 'GetReF erence! 

NSString USING [FreeString, String, StringfromMesaString] 

OptionFile USING [EntryEnumProc, EnumerateEntries. GetStrinqValuel 
«PCLexiconFi1eTypeDefs USING [USEnglishSystemLexicon] 

PCUtilityDefs USING [CheckLex iconF iles] >> 

ProductFactoring USING [Enabled], 

Prototype USING [Find], 

PrototypeExtra USING [Add], 

SchemaDefs USING [GetRootCs, Lschema, IschemaNil] 

SelectionDefs USING [DeselectCsJ, 

Lex iconLi st, LptLexico^Data^LptU^ConData^ist,' Rep 1 IceCont TnueW i JhS^arf ‘sCScanMx^S^Al te rnaJ 1 "T^ ‘ t■ ' Le * 1 c01 ' 01 S P'***'t trs , 

ke y scr^us?:dirr rat,on ' MnD,sp " yAt,rs] - 

StarFileTypeDefs USING [folder], ' 

StarPFOptions USING [starSpe11ing], 

■System USING [gnUEpoch, Greenw ichMeanTimeJ, 

ToolUtilitiesDefs USING [LegalScWnFromSrt], 

TxtDefs USING [textSegmentNi1], 
rxtEditDefs USING [ClearTextSegment], 

IxtScanDefs USING [PopAl 1 Enum, ReadonlyWordFlags , otsnuu 
lextUtilDefs USING [BytesSIze, CopyToBytes. Rdr, ResetWriteri 
XMossage USING [Get, Handle], 

X Format USING [Number, Object, UnsIgnedDecima 1 Format. WriterObjectl, 

XStnng USING [Bytes, ByteSequence. Character. CopyReader, emp tyContext 

reeReailtrtytes, FromChar, FromNSSlrlng , F romSTRING, NSStri ngFromReader. Reader 

x T l ad ,K 2r dy ;a U, ’ kn r n = 0nteXt ' 'Context. WriterBody, Wr i terBodyFromSTRING], 

XTime USING [Append, Current]; J 


ScanCtxt. WIDEN, WordFIagsObject], 


Spel1ingCheckerUtiIPack: PROGRAM 


zc I I iiijbiicGnurUtj I I raCK : rKUliHAM 

F y PORT Q Qno t 1 a ' 


-- ’ uyv.m;LF,t;rueT S . 

lextUtilDefs, XFormat, XMessage, XStrinq, XTime 
EXPORTS SpellingCheckerDefs 
SHARES SelectionDefs, xstring - 

BEGIN OPEN Spe11IngCheckerDefs, SpeningCheckerMessageOefs 

Bug: SIGNAIfBugtype] = CODE; 

Bugtype: TYPE = {impossible}; 


TxtDefs. IxtScanDefs, TextutilOefs, XF: XFormat, XS: xstring: 


-TYPES 

MakeDocCtxt: TYPE = LONG POINTER TO MakeDocCtxtObject 
MakeDocCtxtObject: PUBLIC TYPE - RECORD [ 
fileDoc: NSFi1e.Handle, 
dec: DocInterchangeDefs.Doc, 
unused: ARRAY[0.,16) OF WORD 
]; -- concrete type cloned from TextUtilPack 


Word Item: TYPE = LONG POINTER TO WordltemObject: 
WordltemObject: TYPE - RECORD[ 
bytes: XS,Bytes, 
length: CARDINAL, 

flagsObject; TxtScanDefs.WordFlagsObject]; 


- CONSTANTS 


anierEngSysLexNanie: NSStr ing. String = NSSt r i ng . Stri ngFromMesaSt rl 
h: XMessage.Handle = Spel1ingCheckerMessageOefs.GetHandleH* 
newLineChar: XS.Character * LOOPHOLE[CharDefs.Roman[newLinel]; 
rbNewLme: XS . ReaderBody - XS. FromChar[@newLi neChar ]; 
scEditedFlag ID: DocSpeciaIDefs.EditedF 1 agID - 0- 
shortzone: UNCOUNTED ZONE = BWSZone.shortLifetime: 


ng["AmericanEnglish"L]; 


VARIABLES 
- PROCEDURES 


ClearHostDocCs: PUBLIC PROC = { 

OPEN c: checkCtxt; 

- Get lschema from doc 
IF c.doc H NIL THEN { 

rootCs: SchemaDefs. Lschema «- SchemaDefs.GetRootCs[].1 schema: 
IF rootCs tt SchemaDefs . 1 schemaNi 1 

AND DocumentDefs.DocFromIzn[rootCs.izn] = c.doc THEN 
SelectionDefs.DeselectCs[]; 
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"’SpE^^c^cKCtxt 10 PR ° C R£TUMS [sysLexSelectedForLookup: BOOL 
FOR 1; CARDINAL IN [0..c.1 ex icons.nLex,cons) 00 

- ;’®^ 0nSCl] ' SySte ' l ' LeX AN ° c - 1 «^ons[1]. lookup THEN 
syslexSeIectedForLookup «- TRUE; 


IF c.lexicons[i],lexicon # NIL THEN 
CloseLexicon[@c.lexiconsfill- 
ENDLOOP; l jj ’ 


FALSE] = { 


H PR0C C' ex0ata: Lptl.exiconD.ta] = f 

displayAttributes: Di sp I ayAttrs .lexicon; 1 
attrList: ARRAY [0 .. 1 ) OF NSFile.A ttr ibu te * r 
[extended[type: SpellingCheckerOefs.displayAttrTvoe 
value: pESCRIPT0R[@displayAttr1butes, yPe ' 

biZE [DisplayAttrs.lex icon], WORD]]]]; 

lex Da ta.lexico n, closepexData.lexicon]- 

1exuata.lexicon ^ Nil ; 

IF -lexData.systomLax THEN { 

--set display attributes here 
d i sp. 1 ayA t tributes r fvar: lexiconf 
selectedForLookUp: lexData.lookup. 
selectedForEdit: lexData.edit]]; 

NSFile.ChangeAttributes[lexData.file 

NSFile.Close[lexData.fi le]■ 
lexData.file - NSF i 1 e . nu 11 Hand! e; 


DESCR1PT0R[attrlistj]; 


lexicons are properly stamped... 

internalName! S XSt r ing^ReaderBod'y^^XSt M ng ' FromSTRINGf "Spe 1 ^° L C h ' Spe 1 M a 8 c Lecke rDe f s . CheckCtx 11 . f 

nAllocated: CARDINAL e io■ 
nLexicons: CARDINAL e O' 

syste«" S BOOL t t*FALSE?* t * t1St * ™'^[Le-conDataListrnAn ocated J]: 
internaINameNS: NSStriog.String - XString.NSStr 1 ngFromReaderfentry, BWSZone.shortL1fetime]• 

^aswsssKiSsr: sap- -~i -. 

NSF ile.GetAttributesByName[ 

directory: applFolder, 
path: internaINameNS, 

selections: [interpreted: [filelD: 1RUE, service- fruei 

extended: DESCRIRrOR[extendedSelection s 11 ' 

attributes: ©attributes JJ ' 

' NSFile.Error => GOTO SkipThisOnej: 

AddLe,lcon[«ttributes: Sattributes. userName: value, system: TRUE): 

NSFile.ClearAttributes[©attributes]; 

EXITS 

SkipThisOne => NULL: 

}; ^-AddSystemLexiconFromUserName 

Optionalle .GetStringValue[ 

section: ©sectionName, entry: entry callBark- . 

index: 0 , file: adf]- y ' Bac *' AddSystemLexiconFroniUserNanie, 

NSString.Freestring[BWSZone.shortLifetime, InternalNameNSl■ 
j. AddSystemLexiconFromEntryName ' 

-- needs attributes needed by AddLexicon, plus 'name' 
use f Ctn rLis tF roc: NSFi1e.AttributesProc - f 

AddLexi , con[attributesf e attMbutes tr userName^ S @userName^system: n FALSE]} ; 

Addi" eSl ? S fneID ' service, and extended selections: 

fileAttrs: LONG^POINTE^To' Lex iconDef s Uex iconp 1 } leAttrs • XStr in 9 • Reader , system: BOOL ] = [ 
displayAttrs: LexiconDisplayAttrs; 

IF attributes.extended - NIL OR attributes. extended^]. value NIL THEN RETURN: 

fileAttrs «■ LOOPHOLE[BASE[attributes .extendedTOl valuell- 
OR l*Ere™ r * r : t t rF ^ a J tr,b,lt#, - extend8d i: i J-^* ^L) ]J - 
ELSE LOOPHOLE[BASE[attributesfextended[ 1 vaiuej] SPl ayAttrS lex 1con i THEN NIL 

IF nLexicons = nAllocated THEN { 

FOR 1: CAR0tNAL P IN e [0 CO nLexicons) t D0' ZOI ’ e ' NEWCLeXlCOn0ataLi£t[,n '' 11oCated * ( "A11 ocated+S)) ] ] ; 
tempLexicons[ 1 ] <- lexicons[i]; 
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ENDLOOP; 

c. zone.FREEfOlexicons]; 
lexicons *• tempLexicons ; 

lexicons[nLexicons] ♦- [ 

I*!' ^Kri bUteS ■ f i TelD. attributes.service], 
file: NSFile.nullHandle, 
name: XS.CopyReader[userName, c.zonel 
lexicon: NIL, 
nWords: 0 , 
systemLex; system, 
lookup: SELECT TRUE FROM 
system systemLexSelectedForLookUp 
(disp1ayAttrs = NFL) => FALSE, 

ENDCASF o displayAttrs.selectedForLookUp, 
edit: SELECT TRUE FROM 

system, (displayAttrs = NIL) => FALSE, 

^ ENDCASE => displayAttrs.sc 1ectedForEdit 

nLexicons k nLexicons + 1 ; 

}: --AddLexicon 

^. IC , • oFLexiconetnr 0 NSFi le . nul lHandle THEN 
NSFi le.Li$t[directory: c.userLexiconCtnr 
proc: userCtnrListProc, 

se?ections-T : [e<,Ua ' Ctt »' >e t'' 8, “ e: “ashTabieLex iconOef s . fneTyee]] J ]]. 

interpreted: [filefD: TRUE, service: TRUE name- TRUE! 

extended: DESCRIPTOR[extendedSelections]]]: J ’ 


IE appIFolderRef 0 NSFile.nullReference THEN f 
IF (a pp| Folder «• NSF1le.OpenByReference [applFolderRef1) 0 NSEHe 

n ^a d fTNRF C3 r 0nF ?; D de e' FindDeScr lP ti oaFile[applFo?de; ] ; 
ii- adf tt NSFi le . nullReference THEN J 

OptionFile.EnumerateEntries[ 

SsectionName, AddSystemLexiconFromEntryName. adf]: 
NSFile.Close[applFolderj: 

}; 

IF c. lexicons * NIL 

OR (c.lex icons.nLexicons 0 nLexicons) THEN f 
II- c. lexicons 0 NIL THEN Destroy Lex iconListsT I: 
c. ox icons <- c. zone. NEW[LexiconDataL is t[nl.ex icons ]]■ 
c.lexicons Edit <- c.zone.NEW[LexiconList[nLexicons ■ 
c.lexiconsLookUp *• c.zone.NEW[LexiconList[nLexicons]] : 

FOR 1: CARDINAL IN [0nLexicons) DO 
c. lexicons[ 1 ] <- lexiconsfi]- 
ENDLOOP; J 


■ nullHandle THEN ( 


c.zone.FREE[@lexicons]; 

Cr RF™V r 'u iS ^ PUBLIC PR0C [oDa ' rsMax : CARDINAL. 

RETURN [HashTableTempLex1conDefs.OpenTempi 
nEntriesMax: nPairsMax. 
hashTableType: ordinary, 
sizeValues: SIZEfWordltemObject], 
valueFreeProc: PairListFreeProc 

zJ]: 

}: 

PairListFreeProc: HashTableTempLexiconDefs.ValueFreeProc * f 

wltem: wordltem = LOOPHOLE[value]; eeProc ... [ 

-need clientCtxt for temp lexicons too 
checkCtxt.zone.FREE£@wItern.bytes]; 


UNCOUNTED ZONE] RETURNS [LexIconDefs.LexiconHandle] 


PUBUC PR0C [list: Lex i conDef s. Lex iconHandl e] 

HashTableTempLexiconDefs.CloseTemp[list]; ej 

Cf wnen,: B Sor d Uem- C,ate: XS -'KeLerB^dJ^as'sSc^teF^^ TxtScanDefs .ReadonlyWordF lags] RETURNS 

[found, wltem] * HashTableTempLexiconDefs , LookUpTempWordD m, word, wordFlags]; 

IF found THEN { 
associate «- [ 

context: XS.vanillaContext, 
limit: wltem.length, 
offset; 0 , 

bytes: wltem.bytes]; 
associateFlags «- @wltern.f 1 agsObject; 


LmG cm] 

rb. XS.ReaderBody <- XS.FromChar[@tabCharl■ 

msgWorcIsListed: XS.ReaderBody r XMessage ,Get[h, keySCtfordsListedlnDoc]; 
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IsTemp: LONG STRING = [100]; 

wb: XS.WriterBody <- XS.WriterBodyFromSTRING[s: IsTemp 
time; System.GreenwichMeanTime <- XTime.Current[]; 


homogeneous: 


TRUE]; 


-- put the current date/time In the document's header 
XT1me.Append[@wb. time]; 

DocInterchangeDefs.AppendText[[doc[doc]], Textut1lOefs.RdrfOwb]. 


DocInterchangeDefs.AppendText[[doc[doc]], 8rb, 

DocInterchangeDefs.AppendText[[doc[doc]], 0 rb, 


XS.emptyContex t]; 
XS.emptyContext]; 


TextUtilDefs.ResetWriter[@wb]; 

( 0 : XT,Object e XF.WriterObject[@wb]; 

XT. Numbe r[@o , nWords, XF.UnsignedDecimalForniat]; 


XS.emptyContext]: 


DocInterchangeDefs.AppendText[[doc[doc]], 
DocInterchangeDefs.AppendText[[doc[doc]], 


Rdr[Swb], XS.emptyContext]; 
@msgWordsL1sted, XS.emptyContext]; 


}; -- AppendNWordsAndTIme 


MakeDoc: PUBLIC PROC [lexicon: LexiconDefs.LexiconHandle 
fileDoc: NSFile.Handle; 
doc: DodnterchangeOefs.DOC: 


name: XStr i ng.Reader] RETURNS [ok: BOOL] = { 


^propose: sort TStrings (small 
need to fix relationship with 1 


fixed size): the prefix is known to not change and be chsetRoman: 
icon to keep this knowledge private to lexicon 


the bytes are known to be constant. 


TString: TYPE - RECORD [offset, length: CARDINAL]; 


IF (don - DocInterchangeDefs.StartCreationn.doc) - NIL THEN 
RETURN [ok: FALSE]; ’ 


AppendNWordsAndTime[doc, lexicon.getNWords[lex Icon].nWordsCur]; 

DocIn terchangeDefs.AppendText[[doc[doc]], SrbNewLlne. XS.emptyContext]: 
AddWord$ToDoc[1ex icon, doc]; 

fileDoc *■ DocInterchangeDefs .Fini$hCreation[@doc] .docFile ; 


fnsName: fSString.Strlng = XString.NSStrlngFromReader[name, shortZone 
at !'-TSt: ARRAY [0..1) OF NSFi1e.A11ribute <- [[name[value: nsNamelll 
ref Doc: NSFi1e.Reference «- NSFIle.GetReference[fi 1 eDoc]; J ‘ 

'!L F l er !I' Cr ' C Mn r NS,: ' le " Refererice ■ StarDesktop .GetCurrentDesktopF ileT]: 
dtl-landle: NSFI le . Handle «■ NSFi le .OpenByReference[dtReferencc]; 



NSFile.Move[file : fileDoc, destination: dtHandle, attributes' 
NSFile.Close[f1leDoc]; 

NSFile.Close[dtHandle]: 

StarDesktop.AddRefereneeToDesktopfreference: refDoc]■ 
NSString.FreeString[shortZone. nsName]; : 


DESCR[PTOR[attrList]J: 


RETURN [ok: ERUE]; 
}; --MakeDoc 


AddWordsToDoc: PROC [lexicon: LexIconDefs.LexiconHandle 
-- we will sort ReaderBodies (more efficient to sort 


. doc: DocInterehangeDefs.DOC] 
TStrings?) 


j i 


AddWordToDoc: LexiconDefs.WordProc - [ 

DocInterchangeDefs.AppendNewParagraph[[doc[docl]]; 
DocInterchangeDefs.AppendText[[doc[doc]]. word. XS.unknownContext]; 


lexicon.enumerate[lexicon, AddWordToDoc -- enum. is supposed be in 
«Someday we should Inform the user if this happens:>> 

■ HashTabIeLexiconDefs.SpacelnadequateCannotEnumerate -> RESUME]: 


} = 


sort-order 


SetDocContext: PUBLIC PROC [doc: DocumentDefs.Hand lei - ( 
OPEN c: checkCtxt; J ^ 

IF doc = c.doc THEN RETURN; 


StopAlternativesGenerationf]; 

IF c.doc M NIL THEN { -- clear old text context 

scSC: SCScanCtxt = @c.scScanCtxtObject; 

IF scSC.wordScanCtxtObject.scanCtxtObject.ec # NIL THEN f 
TxtScanDefs.PopAl1Enum[WIDEN[scSC]]; 


-in the middle of scan 


ReplaceContinueWithStart[]; 

IF scSC,wordScanCtxtObject.ts M textSegmentNi1 THEN 

TxtEditDefs.ClearTextSegment[@scSC.wordScanCtxtObject.ts]; 

ClearFdbkParms[]; 

}: 


c.doc *- doc; 

IE C.doc » NIL THEN SetDocNotEd 1 ted[c.doc]: 


SetDocNotEdited: PUBLIC PROC [doc: DocumentDefs .Handle 1 - f 
DocSpecialDefs.ClearClientsEdltedFlagfdoc, scEditedFlaglO] ); 

SetPair: PUBLIC PROC [list: LexiconDefs.LexiconHandle, word: XS.Reader. wordFlags: 


rxtScanOefs.ReadonlyWordFlags. associate: XS.Reader, 
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associateFlags: TxtScanDefs.ReadonlyWordFlags] RETURNS [ok: BOOL <- irue 1 = f 
added: BOOL; J *- 

wltem: WordItem; 

assocIateLength: CARDINAL = BytesSize[associate]; 

-includes initial chset change if not Roman 


[added, LOOPHOLE[wltem, HashTableTempLexiconDefs.Value]] 
!LexiconDefs.LexiconlsFu 11 => GOTO notOKj; 


HashTableTempLexiconDefs.AddTempWord[Iist, word. wordFlags 


IF added THEN 

wltem. bytes «• checkCtxt .zone .NEW[XS.ByteSequence[associateLength]] 
ELSE ( --already there 

wordsAvail: CARDINAL = SIZE[XS.ByteSequenceTwItern.1enqth]*]• 
wordsNeeded: CARDINAL = SIZE[XS.B y teSequence[associateLength]]; 

IF wordsAvail # wordsNeeded THEN { 
checkCtxt.zone.FREE[@wItero.bytes]; 

wTtern.bytes «■ checkCtxt.zone.NEW[XS.ByteSequence[associateLength]]; 


CopyToBytes[to: wltem.bytes, from: associate, n; associateLength]; 

wltem. length «- associateLength ; 
wltern. f 1 agsObject «■ assoc iateFlagst; 
ok <- TRUE; 


EXITS 

notOK => RETURN [ok: FALSE]; 


UserEditedDoc: PUBLIC PROC [doc: DocumentDefs.Handle] RETURNS [BOOL] = { 
RE TURN[DocSpecialDefs.GetClientsEditedFlag[doc. scEditedFlagID]] }: 

-- PRIVATE 

--all lexicons and files had better be closed 
DestroyLexiconLlstS: PROC = { 

OPEN c: checkCtxt; 

FOR i: CARDINAL IN [0..c.1 exicons.nLexicons) DO 

XString.FreeReaderBytes[c.lexiconsf i ] .name, c zone!* 

ENDLOOP; J ’ 

c. zone.FRE£[@c.lexicons]; 
c.zone.FREE[@c.lexiconsEdit]; 
c. zone.FREE[6c„lexiconsLookup]; 



defaultAttrs: DisplayAttrs.wn = [ 
van: wn[ 


scWn: ToolUt.il itiesOefs . LegalScWnFromSrt[[sc : [641 22] 

rsBody: [350, 200], 

scope: all, 

autoCorrect: FALSE, 

includeAnchoredFrames: FALSE, 

sysLexSelectedForLookUp: TRUE]]; 

extendedAttrs: ARRAY [0.. 1) OF NSFiIe.ExtendedAttributeTvpe ■ 
displayAttrType]; 


lastModif iedOn: Sy stem .Greenw i chMeanT inie, dispAttrs: DisplayAttrs.wn] 
rs: [0, 0]]], 

L 


found: BOOL *■ FALSE: 

rbLexiconFolder: XS.ReaderBody <- XMessage.Get[h, keySCLexiconFolder]; 
lexIconCtnrName: NSStr ing . Stri ng = JtS .NSStringFromReader[@rbLe« IconFol der 
filterList: ARRAY [0..2) OF NSFi1e.Fi1 ter «■ [ 

[equal[[name[lexiconCtnrName]]]], 

[equal[[type[StarFiIeTypeDefs.fo1der <<lexiconFolder>>]]]] 


]: 

dtReference: NSFile.Reference 
dtHandle: NSFile.Handle: 


StarDesktop.GetCurrentDesktopFile[]: 


checkCtxt.zone]: 


ListProc: NSFile.AttributesProc = ( 

file «■ NSFile.OpenByReference[[attributes.fileID. attributes.servicell• 
lastModif iedOn «- attributes .mod i f iedOn; 
dispAttrs «- IF (attributes.extended = NIL) 

OR (attributes.extended[0].value = NIL) 

^OR (LENGTH[attributes.extended[0].value] * SIZE[DispIayAttrs.wn]) THEN defaultAttrs 

LOOPHOLE[BASE[a ttributes .extended[0].vaIue1, WnDispl ayAttrs It• 
found <- TRUE; 1 ' 

RETURN [continue: FALSE]; 

}; --ListProc 


dtHandle «- NSFi le .OpenByReference[dtReference]; 

NSFile.List[directory: dtHandle, 
proc: ListProc. 

selections: [interpreted: [filelD: TRUE, service: TRUE, modifIedOn• TRUE 1 
scope: [filter: [and[DESCRIPTOR[filterList]]]] ] : 

NSFtle.Close[dtHandle]; 


extended: DESCRIPTOR[extendedAttrs]], 


IF ~found THEN [ 

file *• NSFi!e.nul 1 Handle; 
lastModif iedOn «• System. gmtEpoch; 
dispAttrs «■ defaultAttrs; 

}: 


HSString.Freestring[checkCtxt.zone, I exiconCtnrName]; 
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IMt: PROC = f 

8EGIN UCtFaCt0rin3 ' Enab,ed|:StarPFO P t ions.starSpemngl THEN 

einptyLexicoPNa m ef'NM?r i r ng a stni^g eSS xr N sst tCh ' ^^"'PW-exIconJ; 

system lexicons e ]: 

lexicons>> 

ref^»„ Pr0t °^ yPe p, ' i,,ate lexicon 
reference <- Prototype.FindT 

type: HashTableLexiconDefs filATuno 

V reference - NSF , VerS, °" : ’’ ^’^btypeBlankOocJ • 

rr ELSE NSF i 1 e .OpenByReferencerrefe^f 6 ™ N NSFi ,e "Handle 
Ef lex = NSFile.nullHandle THEN f refere ' lce ] : 

e h X / hT L \ X 1 1C ° n0efSlCr ^^exico [ 
nashTable, NSFilP nimu™,n L 

PrototypeExtra. Add[ emptyLex IconName, 1000, TRUE]; 

fLs i nie: lM ' “ e, ' Sl °" : '■ SUbtyPe: c *-lt il Oafs, sub typeBl a n k D 0 c ]; 

"NSFH^D^^^r-^C^^onDaTs.GetFiie.Et^fej] THEN ( 

l’roLotypeExtra.Add[ d1e ’ Gnlpt y L ex iconName. 1000 , TRUE]- 

„„ }: fi ' e: ,S *' VerSi °" : *• SUbtyPe: EE° cU t i 1 Def s . subtypeBiankn.c ( ■ 

END; 


- mainline 

Init[] : 


END. 
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_ FUe: Spel1ingCheckerWnPack.mesa - last edit- 
-- Bartlett:OSBU SouthiXerox 2-Dec-87 13-29-06 
■■ Marks.ES 5-Aug-87 14:14:28 

■ Bartlett.ES 21-Feb-86 12:10:09 

■" Walden.ES 16-Aug-84 14:42:02 

- Lewis 17-JuI-84 18:55:29 


Copyright (C) 1986. 1987 by Xerox Corporation. All rights reserved, 
items flagged with ***TTT will go away when the folder UI is done "right" 
DIRECTORY 

Atom USING [ATOM, MakeAtom, null], 

Attention USING [AddMenuItem, Post. RemoveMenuItem] 

context USING [Create. Find, NopDestroyProc, Type, UniqueTvoel 

DocEventDefs USING [ ’ ' 

AddDependency, AgcntProcedure, Dependency. RemoveDependencv 1 
DocumentDefs USING [Getlzn, Handle], 

DocUti1Defs USING [FreeSystemDoc, GetSystomDoc, LockSystemDoc] 

Event USING [AddDependency, AgentProcedure] 

EormWIndow USING [ 

Appendltem, AppendLine, BooleanChangeProc. CholceChangeProc, Choiceltem 
Destroyltem, FreeTextHintsProc. GetBooleanltemValue. GetChoiceltemValue. 
GetFextltemValue, HasAnyBeenChanged, HasBeenChanged; ItemKey, 

LayoutProc, Line, MakeBooleanltem, MakeChoiceltem, Makelntegerltem 
MakeltemsProc MakeTextltem, Repaint, ResetAllChanged, SetBoolearntemValue, 
SeLLhoiceltemValue, SetlntegerltemValue, Set lextltemValue, Setvis ib i 1 I tv 
TabStops, TextHintsProc, Visibility], 

InstanceDefs USING [rrefNil], 

Heap USING [Create, NWords], 

LexiconDefs USING [CreateLexicon, Lexicons, OpenlexIcon], 

MenuData USING [Creat'st tern, Itemliandle, MenuProcl 
NSFile USING [ 

Attribute, Close, Delete, Ge tDefau I tSession, nullHandle, nuMReference 
OpenByReference, Session], 

NSFileExtra USING [ChangeAttributesPrivi1eged], 

NSSlring USING [String, StringPromMesaStrinq1 
Process USING [Detach], 

ProductFactoring USING [Enabled], 

PropertySheet USING [Create, GetFormWindows, 

Spell 1ngCheckerDe.fs USING [ 

AddMenuCommands, AddPopupMenu. CheckCtxt, 

CloseLexicons, CreateAlternativesProcess, 

CreatelexiconLists, CreatePairList, DestroyPairList. DisplayAttrs 
displayALLrType, LptLexiconData. OpenUserLexIconCtnr, 
PopUpMenuMakeStringProc, ScopeFromChoice, SetDocContext. WnOisplavAttrs1 
SpelIingChockerMessageDefs, *' 

StarDesktop USING [GetCurrentDesktopFi 1 e]. 

StarPFOptions USING [starSpelling], 

StarWindowShel 1 USING [GetAva11ableBodyWindowDims. Handle Pop 
PoppedProc. Push, She 11FromChi1d, SIeepOrDestroyI 
StarWindowShe11 Extra USING [SetSleeps] 

System USING [ 

GetGreenwichMeanTime, gmtEpoch, GreenwichMeanrime. SecondsSinceEpochI 
lxt,B 1 ocKDefs USING [Create. CreateParms], 

Window USING [BitmapPlace, Dims, Handle. Place] 

XMessage USING [Get, Handle], 

XString USING [FreeReaderBytes, nu 11 HeaderBody, Reader, ReaderBodyJ; 

SpellingCheckerWnPack: MONITOR 
IMPORTS 

Atom, Attention, Context, DocEventDefs, OocumentDefs, DocUtilDefs Event 
FormWindow, Heap, LexiconDefs, MenuData, NSFile, NSFileExtra, NSStrinn 
Process, ProductFactoring, PropertySheet, Spel11ngCheckerDefs 
r P ?" in ^ Ck * r ' Messa9eDefs ' StarDesktop, StarWindowShel 1 , StarWindowShel 1 Extr 
Tx tB1ockDef s, Window, XMessage, XString 
EXPORTS Spel1ingCheckerDefs 
SHARES MenuData = 

BEGIN 


MenultemProc], 

CheckCtxtObject, ChoiceFromScope . 
Des troyAlternativesProcess . 


OPEN FW: FormWindow, Spel1ingCheckerDefs, 
SpellingCheckerMessageDefs. XM: XMessaqe. 
XS: XString: 


-- TYPES 


ScopeType: TYPE - (allText, remainingText. selectedText); 

ItemData: TYPE - LONG POINTER TO AqltemData; 

AqltemOata: TYPE = RECORD [ 
scope: ScopeType «• allText. 
checkFrames: BOOLEAN FALSE, 
autoCorrect: BOOLEAN «• FALSE, 
misspelling: XS.ReaderBody 4- XS.nullReaderBody, 
correction: XS .ReaderBody *■ XS. nu 11 ReaderBodyJ ; 

Items: TYPE - {scope, checkFrames, autoCorrect. misspelling, correction): 


-- CONSTANTS 


Spel1ingCheckerCtxtType: Context,Type = Context.UnigueTvDen■ 
h: XM.Handle - GetHandle[]; LJ ' 
initialStringLength: CARDINAL = 40: 


System, 
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SH0ULD 8E ^ A ° EF: DEFINES HUM8ER ° F ITEMS IN P$ 8EF0Rt LEXIC0N «™ 
size: Window.Dims = [480, 300]; 
tabStopInterval: CARDINAL = 100; 
spaceAboveLine: CARDINAL = 5; 


GLOBAL VARIABLES 


0n1 y one instance of any option sheet can be on 
shared by the procedures used in this module. The 
what is recommended to be kept in a global frame, b 


the screen at any given time, so it is safe 
permanent data record is kept in the global 
ut I don't know how to store permanent data 


checkCtxt: PUBLIC CheckCtxt <- NIL; 

paginationDependency: DocEventDefs.Dependency «- LOOPHOLE[LONG[NIL]]; 
docDeleteDependency: DocEventDefs .Dependency «- LOOPHOLE[LONG[NILll; 
docCloseDependency: DocEventDefs .Dependency <- LOOPHOLEfLONGrNILIl • 
fw: Window.Handle «■ NIL; JJ ‘ 

shell; StarWindowShel1.Handle: 
myZone: UNCOUNTED ZONE «■ NIL; 


to not put monitors around the data 
frame. It is borderline in size for 
in hyperspace. 


-- SIGNALS 


Bug: SIGNAL [Bugtype] = CODE; 

Elugtype: TYPE = (impossible, badValue, error); 


- PROCEDURES 


currentLexicon: CARDINAL] 


BuiIdLexiconRow: PROC [ 

- - builds and appends lexicon row. 

window: Window.Handle, wthRow: INTEGER, lex: LptLexiconData 
ISvNWords: LONG STRING = [50]; 
xcMinusNWordsInfo: INTEGER ^wthRow - 50; allow space for nWcrds display 
ilotOpen: BOOL <- lex.lexicon - NIL; M Y 

visibility: FW.Visibility <- IF notOpen THEN invisible ELSE visible; 
edi tVisibi 1 Uy : FW.Visibility <- tF lex , sys teniLex THEN invisibleChost ELSE visible; 

kludge multiplication - because four entries in line 
nextltem: CARDINAL *■ lastltem + (4*currentLex i con ); 


leadingMargin: CARDINAL - 5; 
line: FW.Line; 

tabChoice: FW.TabStops = [fixed[tabStopIntervarj]; 

- FW.SetTabStops[window: window. tabStops: tabChoicel: 

FW.MakeBooleanItem[ 

window; window, myKey: nextltem, 

initBoolean: iex.lookup, label: [string[XM.Get[h, keySCLookUp]]], 
visibility; visibility, changeProc: LookUpStateChanqed ]• 
FW.MakeBooleanItem[ u 

window: window, myKey: nextltem + l, 

initBoolean: lex.edit, label; [string[XM.Get[h, keySCEditm, 
visibility: editvislbility, changeProc: EditStateChannedl• 
EW,MakeTextltem[ 1 ' 

window: window, myKey: nextltem + 2, 
initstring: lex.name, 

readonly: TRUE, boxed: FALSE, width: 260, 
visibility: visibility]; 

FW.MakeIntegerItem[ 

window: window, myKey: nextltem + 3, 
initlnteger: LOOPHOLE[lex.nWords], 
readonly: TRUE, boxed: FALSE, width: 42, 
visibility: visibility]; 


line <- FW.AppendLine[window: window, spaceAboveLine: spaceAboveLine!■ 
EV/.AppendItem[ 

window: window, item: nextltem, line; line, preMarqin 10 
repaint; FALSE]; 

FW.Appendltemf 

window; window, item; nextltem * 1, line: line, preNargin' id 
repaint: FALSE]; 

FW.Append Item[ 

window: window, item: nextltem + 2, line: line, preMarqin- 10 
repaint: FALSE]; ' 

FW.Appendltemf 

window: window, item: nextltem + 3, line: line, preMarqiiv 10 
repaint: FALSE]; 1 


}: -- Bui1dLexiconRow 


CleanUpPermanentData; PROCEDURE - Q; 


ClearFdbkParms: PUBLIC PROC = { 

c: CheckCtxt <- Context, F ind[Spel 1 ingCheckerCtxtType , fwl- 
emptyReaderBody: XS.ReaderBody <- XS.nullReaderBody: 

IF c.lastCorrectionValue # XS.nullReaderBody THEN { 

FW.SetText1temValue[c.fw. Items.misspel1ing,ORD, NIL]: 
XS.FreeReaderBytes[@c. I as tCo meet ionValue, c.zone]: 
c.lastCorrectionValue f XS.nullReaderBodyi; 

}: -- ClearFdbkParms 
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--for fast close 


CloselnBkgd: ENTRY PROC [scWn: Window,Dims 
ENABLE UNWIND => NULL; 
SysLexSelectedForLookUp: BOOL; 


rsSody: Window.PI ace, c: CheckCtxt] 


{ 


OestroyAl LernativesProcessfc.pAlternativesGeneration]; 
SetDocContext[NIL]; --Clears info parm, nils lastCorrectionValue, 

IF c.ignoreList 0 NIL THEN 
c.ignoreList.ciose[c.ignoreLlst]; 

IF c. ignoreLexicon 0 NSFile.nullHandle THEN 
NSFile.Delete[c., ignoreLexicon]; 

DestroyPa i rl_l st[c , co meeti onLi st]; 


pops all enumerators 


FW.SetTextItemVa1ue[c.fw, Items.correction.ORD, NILl; 

FW.SetTextItemValue[c.fw, Items.misspelling.ORD, NILl; 
sysLexSelectedForLookUp <- CloseLexicons[]; -- close all lexicons files 

save IncludeAnchors and auto-correct with user lex ctnr 
IF c.userLexiconCtnr 0 NSFile.nul1 Handle THEN f 
attiList; ARRAY [0..1) OF NSFi1e,Attribute «■ [ 

[extended[type: Spel1ingCheckerDefs.displayAttrType 
value: DESCRIPTOR[@dispAttrs, ' 

SIZE [wn OisplayAttrs], WORD]]]]; 

dispAttrs: wn DisplayAttrs <- [ 
var: wn[scWn: LOOPHOLE[scWn], 
rsBody: LOOPHOLE[rsBody]. 

scope: ScopeIromChoice[FW,GetChoiceltemValue[c.fw, I terns.scope.ORD]1 
autoCorrect: FW .GetBoolean [ teniValuefc . fw , I terns . au toCor rec r ORD] 
inc udeAnchoredFrames: FW,GetBoo1eanltemVa1ue[c.fw, Items.autoCorrect ORD1 
sysLexSelectedForLookUp: sysLexSelectedForLookUp ,UHi)j, 

1 : 


--so modifiedOn date won't be updated when these attrs are 
NSFileExtra.ChangeAttributesPrivileged[c.userLexiconCtnr, 
NSFile.Close[c.userLex iconCtnr]: 


changes 

DESCRIP LOR[attrLi 


st J ]: 


CloseUti1; PUBLIC PROC [fw: Window.Hand Ie, itemData: LONG UNSPECIFIf D 1 = [ 
shell: StarWindowShell .Handle «- StarWindowShe 11 .She 11 FromChi ld[fw | : 

[] «■ StarWindowShel1.Pop[$hel 1 ]; 

}; -- CloseUt11 


Col 1ectValues: PROCEDURE [fw: Window.Handle] - { 

itemData: ItemData = Context.Find[Spel1ingCheckerCtxtType, fw]* 

IF ~FW.HasAnyBeenChanged[fw] THEN RETURN; 

FOR myltem: Items IN Items DO 

itemKey: FW.ItemKey = myltem.ORD; 

IF -FW.HasBeenChanged[fw, itemKey] THEN LOOP: 

SELECT myltem FROM 
scope -> 

itemData. scope «• VAL[FW.GetCho1ceItemValue[fw, ttemKevll* 
checkFrames => 

itemData. checkFrames «■ FW.GetBooleanl temVa I ueffw, itemKevl* 
autoCorrect => JJ ’ 

itemData.autoCorrect «* FW.GetBooleanItemValue[fw. itemKevl ■ 
misspelling => SIGNAL Bug[impossible]: -- Shouldn't be user editable 

correction => 

ENDCASE l0ata ' COrreCti0n * Forn,W1nd0w - GetTextrtemValu e[fw. itemKey. myZone] 
ENDLOOP; 


FW.ResetAIlChanged[fw]; 

}; -- CollectValues 

DestroyOldLexRows: PROC [fw: Window.Handle] = { 

c: CheckCtxt +■ Context. Find[Spel 1 ingCheckerCtxtType . fw 1 • 

currentltem: CARDINAL <- lastltem; 

IF c. lexicons » NIL THEN { 

numberEntries: CARDINAL - c. lex icons.nLexicons*4: 

FOR i: CARDINAL IN [0..numberEntries) DO 

FW.DestroyItem[window: fw, item: currentltem, repaint: FALSE 1 ■ 
currentltem <- currentltem + 1 : 

ENDLOOP; 

FW.Repaint[c.fw]; 

}; -- DestroyOldLexRows 
DoLayout: FW.LayoutProc = { 

PROCEDURE [window: Wlndow.Handle, clientData: LONG POINTER]* 
leadingMargin: CARDINAL ^5; 
line: FW.Line: 

-- set the tabs for FomiWindow 

tabChoice : FW.TabStops = [fixed[tabStop£nterval]]; 

-- FW.SetTabSt,ops[window: window, tabStops: tabChoicel* 

- Line 1 

l ine <- FW. AppendLine[window: window, spaceAboveLine : SpaceAboveLine I • 
FW.Appendltem[ 

window: window, item: I terns.scope.ORD, line: line, 
tabStop: leadingMargin / tabStopInterval , preMarqin: 101- 
-- Line 2 J 

line «■ FW.AppendLine[window: window. SpaceAboveLine: spaceAboveLine]; 
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FW.AppendItem[ 

window: window, item: Items.checkFrames .ORO, line- line 
preMargin: 10]; 

FW .Appendltem[ 

window: window, item: Items.autoCorrect.ORD. line: line 
preMargin: 10]; 

-- Line 3 

J, 1 "? * F W;AppendLine[w1ndow: window, spaceAboveLine: spaceAboveLine I • 
FW.Append!tem[ 

window: window, item: Items.misspel1ing.ORD, line: line 
tabStop: leadingMargin / tabStopInterva1. preMarqin: 101 
-- Line 4 ' 

'V! " F W- fl PPendLine[window: window, spaceAboveLine: spaceAbovel ino 1■ 
rw.Appendltem[ J 

window: window, item: Items.correction.ORO. line: line 
tabStop: leadingMargin / tabStopInterva!, preMarqin- 101• 

— Line 5 

Add a little space before lexicons 
}; -- DoLayout 


EditStateChanged: FW.BooleanChangeProc = £ 

" [ wi "dow: Window Handle^ item: ItemKey, calledBecauseOf: ChangeReason, 
c. CheckCtxt «■. Context. Find[Spel 1 ingCheckerCtxtType , window]* 
index: CARDINAL = (item - lastltem)/4; 


newValue: Boolean 


c. lex icQns[ index],edit <- newValue: 
c.refreshActiveLists <- TRUE; 

}: -- EditStateChanged 


FreeOata: PROCEDURE - { 

Call this procedure when deactivating the tool. 
It frees the string data from the system zone. 

}: ~ FreeOata 


GetActiveLexicons: PUBLIC CROC RETURNS [lookup, edit: LexiconDefs.Lexicons] = { 

c: CheckCtxt v Context,F1nd[SpellingCheckerCtxtType fwl' 

IF c,refreshActiveLists THEN { 
c.nLookUp <- c.nEdit r 0: 

FOR i: CARDINAL IN [0..c.lex icons.nLexicons) DO 

lex: Spel1ingCheckerDefs.LptLexiconData = Sc.1 ex icons!i1• 

IF lex.edit THEN { 

c. lexiconsEdi t[c. nEdit] *- lex.lexicon: c.nEdit *■ c nEdit ' i- a. 

IF lex.lookup THEN T ’ I’ 

c . 1 e x i co ns Lookup [ c . nLookltp ] *- lex.lexicon: 
c.nLookUp * c.nLookUp * i; 

}: 

ENDLOOP; 

c.refreshActiveLists * FALSE' 

}; 


lOOkUp e 

ELSE ' till L° kUP > ° ™ EN DESCRIPT0R [@ c ' lexiconsLookUp[OJ, 

Otlit <- IF c.nEdit > 0 THEN DESCRIPTOR[@c. 1 ex iconsEdit [0 ], 
}; — GetActiveLexicons 


c.nLookUp] 
c.nEdit) ELSE NIL; 


LookUpStateChanged: FW.BooleanChangeProc = ( 

" C w 1 ndow: window.Fiandle, item: ItemKey, calledBecauseOf: ChangeReason 
c: CheckCtxt <- Context.Find[Spell ingCheckerCtxtType, windowl- 
index: CARDINAL = (item - lastItem)/4: 


newValue: Boolean 


c.lexicons[index]. lookup <- newValue: 
c. refreshActiveLists <- c. inval idAltList «- TRUE; 
}: -- LookUpStateChanged 


MakeItems: FW.MakeI ternsProc = { 

PROC [window; Window.Handle, clientData: LONG POINTER] 
itemData; ItemOata <- myZone .NEWfAqltemData]; 

that the Y are equivalent to when the option sheet was last 

context.treateL 

SpellingCheckerCtxtType, clientData, Context.NopDestroyProc, —cioseUtil 

{ 

all Text: XS.ReaderBody * XM.Get[h, keySCAlIText]: 
remainingText: XS.ReaderBody » XM.Get[h. keySCRemaieingText1• 
selectedText: XS.ReaderBody * XM.Get[h, keySCSeloctedTextl■ 
scope: XS.ReaderBody <• XM.Get[h, keySCScope]; 
choices; ARRAY £0,.3) OF FW.ChoiceItem *- [ 

[string[o, alIText]], [string[l, remaininglextIT, r 
string[2, selectedText)]]; 

FW.MakeChoiceIteni[ 

window: window, myKey: I terns.scope.ORD, tag: escape, 
values: DESCRIPTOR[choices], initChoice: ItemData.scope.ORD 
changeProc: ScopeChanged]}; 


c1osed. 

-- window]; 


t: 

checkFrames: XS.ReaderBody *■ XM.Get[h. keySCCheckFrames1• 
FW.MakeBooleanItem[ 
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{ ™es. label: [stringCcheckFramos]]]}- 

FW t Make8ooleanItem[ ClerBOdy " * M ' Get ^ ^ySCAutoCorrect]: 

inltBoolean d °UemDat y: I * ;e "' s • autoCorrect .ORD, 

{ ' t6m ^ a ^ a -autoCorrect, label: [, trl„ g[a utoCorrec t J]] } ; 

"w s M^;j: t 9 ; te x f [ ReaderBody * 

:« d r : ^rwir y i 8 ^ S ' miSSPenin9 ' ORD - ^,i SS pe,„, 

c 

™ r ;a^e°"tIu S n, t Read6rB0dy * ^Correction]: 


; -i;- ; , ------ 


180]} 


i ; MakeI terns 
W ;S er !f5 e « : Event.AgentProcedure = { 

r ^*r«UBS 8 i: «-"W 

■s»sr Shell <- PropertySheet.Oreatef 
nienuItems* I [ 0nlS ' MakeItem *j menuftemProc : MenuItemProc , 

start: FALSE , “reset: ^mSEl'^ize • FALSE ' defauUs: FALSE. 

Fo rniWi ndo wit ems Layout ■ DoLavnnt h : I" 6 ' t,tle; ©title. 

p!:^z::sssssi!2ir.r ~ w “" 


Menu! teinProc: PropertySheet.Menu! temProc - { 

nienuIteni. ta prdpertySheet tl Menutte f T r '" Wind0 ” : Wil ' dow - H anrtle. 

“ n ? E I URNS [ deatro y : BOOLEAN ► FALSE 1■ ” yPe ' cl,entData i LONG POINTERJ 

SELECT menu Item FROM J 


« 


>> 


Close => {CloseUtH[] eS cidanudp dOW ' 1: C ,eanlJ pPeritianentData[ j} ■ 

Add => {} [ C1 ‘ L J ’ cl «BDpPermanentData[]; RETURN[ok: TRUE]} ■ 
ignore => q : JJ ' 

correct «> (} : 


ENDCASE: 

RETtJRN[ok: FALSE]; 
}i — MenuItemProc 


y c: ChedkCtdt ePr lydat^ E ' ,entDefS ' A9entPr0CedUre ■’ ( 

doc c.doc THEN SetDocContext[NILJ• }• 

"’"“'Ssir ., 

doc - c.doc THEN SetDocContextfNIL]; }; 

IF doc - c.doc THEN SetDocContext[NIL]; }: 

ResetHackOverrides: PROC * f 

DocEventDef s! RemoveDependen^f *° nGedendenc yJ ■ 

ResetHackOverrides[]; 
c.windowOpen *■ FALSE* 

Process.Detach[ FORK 
CloselnBkgdf 

W^ndow^i tm a ppiace[c V fw] adl eB ° dyWind ° wDims l- shel 1 ] 1 
checkCtxt] ]■ ' 

nedn^^r^J^:- 90 —oycsbel,]: 

Open: MenuOata -MenuProc - (Ope„Util [wi „d„ w , LOOPHOLECUemData]] : }: 
OpenLexiconsd prqp lit* P«rh.p, ... 

-assumes all fl les^a^ed^^ UXCa " t0Pen: B00L • fw: Window.Handle] - { 

CheckCtxt <- Context.Find[SpellTngCheckerCtxtType. f„] 

FOR i: CARDINAL IN [0c.!ex,cons.„Lexicons) DO 
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lex: Spe11ingCheckerUefs.LptLexiconData » 0c.lexiconsTil : 
lex.flle *- NSF i 1 e. OpenByReferencefl ex . ref ]; 
lex. lexicon <- LexiconDefs .OpenLex icon[ 

lexiconFile: lex,file, readonly: lex.systemLex, z: c xonel- 
IF lex.lexicon = NIL THEN [ --can't be opened ' '' 

NSFile.Closeflex.file]; 
lex.file «■ NSF i 1 e. nul IHandle; 

IF eraseParmsIflexCantOpen THEN ( 
parm: CARDINAL «• lastltem + 4*1; 

FW.SetVisibllityCc.fw, parm, invisibleGhost, FALSE]; 

lex.lookup <- lex.edit «■ FALSE; --must be false, we've closed the file 

IF -lex.systemLex THEN -erase Edit boolean item 

FW.SetV1sibilityCc.fw, parm+1, invisibleGhost, FALSE 1 • 

FW.RepaintCc.fw]; 

}: 

} --can't be opened 

E1SE lex.nWords *- lex.lexicon.getNWords[lex.lexicon].nWordsCur; 

ENDLOOP; 

}; -- OpenLexicons 


OpenUtil; ENTRY PROC [fw: Window.Handle, myCtxt: LONG UNSPECIFIED! 
ENABLE UNWIND => NULL; J 

{ 

c: CheckCtxt *- myCtxt; 
p: PROCESS; 

dispAttrsObj: wn DisplayAttrs; 
isNewSession; BOOL; 
currentSession; NSFile.Session; 
ctnrLastModifiedOn: System.GreenwichMeanTime; 


SetHackOverrides: PROC = { 

DocEventPaglnate: Atom.ATOM <- Atoni,Mak.eAtoiit["DocEventPagi n ate' L I ■ 

Someth'ngMaybeDeletedFromOoc: Atom.ATOM - Atom.MakeAtom["SomethingMaybeDe1etedFromDoc”Lj■ 
DocEventL 1 ose : Atom. ATOM «- Atom.MakeAtom["DocEventClose''L]; J 

paginationDependency «■ DocEventDef$.AddDependencyf 

agent: MyNotifyDocPaginateProc, myData: c. event; DocEventPaqmate 
remove: NIL]; 

docDeleteDependency «- DocEventDefs . AddDependencyf 
agent: MyNot i fyDocDe1eteProc, myData: c. 
event: SomethingMaybeDeletedFromDoc, remove: NIL]; 
docC loseDependency <- DocEventDef s . AddDependencyC 

agent: MyNotifyDocCloseProc, myData: c, event: DocEventClose 
remove: NIL]; 

- override overlayWn destroy op was 
-- replaced with Context.DestroyProcType 

}: -- SetHackOverrides 


CreatePrivateObjects: PROC = { 

c.pAlternativesGeneration *■ CreateAlternat ivesProcess[]: 
c.correctionList *- CreatePairListCnPairsMax: 250, z: c.zone]' 
c. ignoreLexicon <- LexiconDefs .CreateLexiconC 
type: hashTable, 

parent: NSFile.nulIHandle, --temp file 
name: NSString .StringFromMesaStr ingC"IgnoreList r, L], 
nWordsMax: 10000, -ignored 
enumerable: FALSE]; 

c.ignoreList <- IF c . ignoreLex icon ft NSFI le. nul lHand le THEN 

LexiconDefs.OpenLexicon[c.ignoreLexicon, FALSE, c.zone] ELSE NIL; 
c . re f reshActiveLi sts *■ TRUE: --previous handles are invalid 
c .continueShowing <- FALSE; 


}: --CreatePrivateObjects 


IF 


DO I WANT THIS OR DO I WANT THE SC COMMAND TO BE DEPENDENT ON 
c.windowOpen THEN { 

scMsgSpel 1 ingCheckerAl readyActi ve : XS .ReaderBody «- XM,Get[h, 
Attention.Post[@scM$gSpe11ingCheckerAlreadyActivel- 

RETURN; }; J 


WHETHER OR NOT A SC WINDOW IS ALREADY UP? 
keySCMsgSpel1ingCheckerAlreadyActive]; 


SetHackOverridesC]; 
p «■ FORK CreatePrivateObjectsC]; 

Cc.userLexiconCtnr, ctnrLastMod i f iedOn , d i spAttrsObj ] «- OpenUserLex i conCtnrC 
-if none, RETURNS [nulIHandle, System.gmtEpoch, default attrs] 


currentSession «■ NSFile.GetDefaultSession[]; . 

IsNewSession <- (currentSession ft c . lastUserSession); --***jtt 


-- Determine lexicons with RebuiIdLexiconRows, 


then OpenLexicons when are creating the option sheet. 


IF isNewSession THEN { --***TTT 

c . lastUserSession «- currentSession: 

FW.SetBooleanltemValue[ 

c.fw. Items.autoCorrect.ORD, dlspAttrsObj.autoCorrect I • 

FW.SetBooleanltemValue[ 

c.fw, Items.checkFrames.ORD, dlspAttrsObj.includeAnchoredFrames1• 
FW.SetChoiceItemValue[ ’ 

c.fw, Items.scope.ORD, ChoiceFromScope[dispAttrsObj.scope]]; 


--***TTT 

IF (IsNewSession OR (System.SecondsSinceEpoch[ctnrLastModifiedOn] > 
System.SecondsSinceEpoch[c.1istCreationTime])) 

OR (c.userLexiconCtnr = NSFile.nullHandle) THEN { 
Destroy01dLexRows[c.fw]; 
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JOIlTp nd01,,Shel ' PUSh ^ l ' eW S hel 1: shel1 ’ P°PPedProc: myPoppedProc]; 
HebuildLexiconRows[dispAttrs: SdispAttrsObj, fw: c.fw]; 

ELSE { 

StarWindowStiel ’ .Pus h [newShel 1: shell, poppedProc: myPoppedProcI • 
JOIN p; J 

OpenLexicons[eraseParmsIfLexCantOpen: TRUE, fw: c.fw]; 

c.windowOpen «■ TRUE; - 

}: 

}: -- OpenUtil 


-•-called only when window opens 
assumes the user.can’t update the system lexicon ctnr during 
--lexicons are closed here 
RebuildLexiconRows: PROC [dispAttrs: WnDisplayAtLrs, Ew: Window.Handle1 = f 
c: CheckCtxt *- Context, Find[Spe11 ingCheckerCtxtType , fw] ; 
wthRow: INTEGER = dispAttrs.rsBody.wth - 10 : -- 10'dots'extra/right 


session and continue to use the spelling checker i 


c . 1 i stCreationT ime *• 

IT (c.userLexiconCtnr = NSFile.nulIHandle) 
ELSE System.GetGreenwichMeanTime[]; 


THEN [System.gmtEpochJ 


use System.gmtEpoch as a list create time to flag a Mst created when no user 

f reatet exiconLis ts[ destroy old strings and lists, create row set 

systemLexSelectedForLookup: dispAttrs.sysLexSelectedForLookUp c: cl- 
OpenLexicons[eraseParmsIfLexCantOpen; FALSE, fw; fw]: 


lexicon ctnr was available 


add lexicon rows to property sheet 
FOR i; CARDINAL IN [0..c.1 exicons.nLexicons) DO 
Bu i 1dLexiconRow[ 

window: c.fw. wthRow: wthRow, lex: @c,1 exiconsf i 1 
FW.Repaint[c.fw]; 

ENDLOOP: 

}: -- RebuiIdLexiconRows 


currentl ex icon 


1 ]: 


ScopeChanged: FormWindow.ChoiceChangeProc = f 
SetDocContext[NIL]}; 


-to he called immediately after editing; assumes lexiconOata edit 
UpdateWordCountDisplay: PUBLIC PROC [checkCtxt: CheckClxtT = f 
OPEN c: checkCtxt; J 1 

hasBeenChanged: BOOLEAN «• FALSE: 


indicates the possibility of having been edited 


FOR i: CARDINAL IN [0..c.1 exicons.nLex icons) DO 
lex: LptLexiconData = @c.lexicons[i]; 


IF 


lex.edit THEN { 

nWords: LONG CARDINAL = 1 ex.1 ex 1 con.getNWords[1 ex. 
IF nWords ff lex.nWords THEN [ - update display 

FW.SetIntegerItemValue[ 

window: c.fw, Item: (last I tern + (4*i) + 3 ), 
newValue: LOOPHOLEfnWords]. repaint; FALSE]; 
lex.nWords «- nWords: 
hasBeenChanged *■ TRUE; 

} 


I ex icon].nWordsCur; 


}: 

ENDLOOP; 

IF hasBeenChanged THEN FW.Repaint[c.fw]; 


scTitle: XS.ReaderBody *• XM.Get[h. keySCTitle]: 
item: MenuData.IteroHandle; 

AddSCComrnand: Event.AgentProcedure = f 
item <- MenuData.Createltem[ 

zone: myZone. name: QscTitle, proc: Open. itemData: myData]; 
Attention.AddMenuItem[itern]}; 

RemoveSCCommand: Event.AgentProcedure = { 

Attention.RemoveMenultern[item]; 
dummyProcToForceWait[]; 


dummyProcToForceWait: ENTRY PROC = [ 

ENABLE UNWIND => NULL; 

}: 

In1t: PROC - { 

« Initialize SC tool context if the SC is installed in the product >> 
IF ProductFactoring.Enabled[StarPFOptions.starSpelling] THEN { 

{ 

z: UNCOUNTED ZONE = Heap,Create[ 

initial: 6, increment: 2 , 1argeNodeThreshold: LAST[Heap.NWords11• 
createParms: TxtBlockDefs.CreateParms: 
createParms . 1 schemaParent «• [ 


n that session 
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OocumentDefs.GetIzn[DocUtilDefs.GetSystemDocT1 I 
InstanceDefs.rrefNn]; 
checkout <- z.NEW[CheckCtxtObject]: 
myZone *- checkout. zone *■ z; 

OocUtilDefs.LockSystemOoc[]; 

checkCtxt.scratcbBlock <- TxtBlockDefs.Create[ 

GcreateParms ! UNWIND => DocUt i IDefs . FreeSysteniDocm • 
Docllt i 1 Def s . F reeSys temDoc[] ; 


{ 


logon: Atom.ATOM <- Atom.MakeAtom["Logon"L] ; 
logoff: Atom.ATOM <- Atom .MakeAtom[ "Logof f"L] ; 

TEMPORARY FIX FOR SWS PROBLEM WHEN TRY TO ACCESS DESKTOP DURING INIT CODE 
AddDependency for desktopWIndowAvailable CALL WITH DIRECT CALL TO MakeProoertvSheet 
desk topWindowA vail able: Atom.ATOM *■ Atom.MakeAtomr 
"DesktopWindowAvailable"L]; 

r [ I I Fvoot'n C lHn ePen a enCy r [a3 ' 5 ' 1t: t? akeP ropertySheet, myData: checkCtxt, event: desktopWindowAvai 1 ab lei 
[J «■ Event.AddDependency[agent: AddSCCommand, myData: checkCtxt, event: logon]; J 

LJ *■ Event.AddDependency[agent: RemoveSCCommand, myData: NIL, event- logoff]• 

-- might I want an Event.FreeDataProc here? ' 


WHEN FIXED, SIMPLY REMOVE 


If starting with Loader want to make SC command available 
IF StarDesktop.GetCurrentDesktopFileC] H NSFile.nulIReference THEN { 

[j «- AddSCCommand[event: Atom.null, eventData:NIL. myData: checkCtxt]- 

here" 01116 * KLUDGE!!!M Because MakePropertyShee t is dependent on the event desk topWi ndowAva i lab le , 
[] *• MakePropertySheet[event: Atom.null, eventData: NIL. myData: checkCtxt]: 

}}: ' 


must explicitly call it 


Mainline Code 
Init[ ]; 


END. 

LOG ( 

8- Jun-84 
3 - J u I -84 

l/'-Jul -84 
15-Aug ^84 
might be 

9- Mar-85 
13-Mar -85 
sheet; cl 
15-Mar-85 

1-Apr-85 
12-Apr-85 

1- May-85 
24-Ju l -85 
24-Aug-85 
Daybreaks 
26-Aug-85 
21-Feb-86 
29-May-87 

5-Aug-37 

2- Dec-87 


SpellingCheckerWnPack 


date - 
15:31 
14:46 
18:55 
11:53 
deleted 
10:23: 
17:00 
ear mis 
13:39: 
14:47: 
16:18: 
10:42 
14:36 
10:22 


person action) 

10 - Walden - 0S5.0 release version 1 
19 Walden 

29 - D.J. Lewis - Tie initialization to FeatureDefs product factoring flaq 

05 Walden - Add MyNot1fyDocDeIeteProc (= MyNot1fyDocPaginateProc) [AR 10543] to clear doc context when Document object 

25 - Marks - Update to 0S6. 

39 - Marks - Change property sheet window size: 
spelling parm when close. 

39 - Marks - Add space between property sheet lines. 

31 - Marks - Use BWS product factoring. 

58 - Marks - AR 14335 Post SC command when run with Loader; 

53 - Marks - Default dependencies so don’t get compiler warnings. 

11 - Marks - Increase size of private dictionary name and correction text parms. 

Marks AR 18933: Let Property Sheet mechanisim determine initial placement of SC P.S. 


check if userLexiconCtnr has been deleted between close/open of property 


so will look o.k. on 


id : in nn ’ n ar l? , AR18999: Let. PoppedProc call CloseUtil to handle non-standard close on p s 
12.10.08 Bartlett use LockSystemDoc, FreeSystemDoc 

16:54:19 - Marks - change width of integer item (word count for lexicon) from 35 to 42 
14:14:12 - Marks - widen correction text parm 

13:29:06 - Bartlett - add UNWIND call to FreeSystemDoc for AR 16204 
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- File: ToolUti1itiesOefs.mesa - last edit: 

-- Marks.ES 7-Aug-87 16:37:59 

Copyright (C) 1987 by Xerox Corporation. All rights reserved 


DIRECTORY 

NfrDefs USING [InterruptRequestOn1, 

NSFile USING [Handle. Type], 

NSString USING [String], 

RgnDefs USING [Sc, Srt], 

StandardDefs USING [String], 

StarFileTypeDefs USING [unspecified]; 

ToolUti1itiesOefs: DEFINITIONS IMPORTS NfrDefs - f 
OPEN RgnDefs: 

- TYPES 


CONSTANTS 

*** HACK BECAUSE ParameterDefs NO LONGER EXISTS. 

*** 1 REPLACED toolPstype: ParameterDefs.Pstype WITH 
toolPstype: CARDINAL = 1; --all clients should use this 


toolPstype: CARDINAL, 
for keying parms 


-- PROCEDURES 


FindFile: PROC [directory; NSFi1e.Hand 1e. 
fileName: NSStr ing.Sir i ng - [NIL, 0, 0], 
type: NSFile.Type «- StarF i 1 eTypeDef s . unspec i fied 1 
RETURNS [NSFi1e.Handle |: 

LegalScWnFromSrt: PROC [srt: Srt] RETURNS [Scl; 


StopPressed: PROC RETURNS [BOOL] = INLINE { 
RETURN [NfrDefs.InterruptRequestOn[J]}; 


Str: PROC [1$: LONG STRING] RETURNS [s: 
RE fURN[[LOOPHOLE[@ls.text], Is.length 


StandardDefs.String] 
1s.maxlength]]}; 


}. -- of ToolUtiIitiesDefs 


INLINE { 


LOG (date - person action) 

8- Jun-84 15:54:12 - Walden - OS5.0 release version 1 

9- Mar-85 10:14:29 - Marks - Update for 0S6. 

7-Aug-87 15:44:39 - Marks - Remove GetFileName 
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Fi| e; ToolUtiIItiesPack.mesa - last edit- 
" Marks.ES 7 Aug-87 16:37:18 

- FoolUtilItiesPack.mesa 

Copyright (C) 1987 by Xerox Corporation. All rights reserved 
DIRECTORY 

Atom USING [ATOM, GetProp, MakeAtom, null], 

NSFile USING [Error, Filter, Find, Handle, nul1 Hand Ie, Type] 
NSString USING [String], J 

Rgnllefs USING [Rs, Sc, Srt] , 

StarFileTypeDefs USING [unspecified], 
loolUtilitiesDefs, 

UserFermina 1 USING [screenlleight, screenWidth]: 

ToolUtilitiesPack: PROGRAM 

IMPORTS Atom, NSFile, UserTerntlnal 
EXPORTS ToolUti1itiesDefs - 
BEGIN 


Bug: SIGNAL[Bugtype] = CODE; 
Bugtype: TYPE = (impossible}; 

TYPES 


-- CONSTANTS 

ScreenWidth: CARDINAL - UserTerminal.screenWidth- 
screenHeight: CARDINAL - UserTenni nal , screontleiglit: 
multiNational : Atom.ATOM <- Atom,null; 
extended! anguage : Atom.ATOM <- Atom.null; 


- VARIABLES 
ycMin: INTEGER r 0; 

PROCEDURES 


-- value set in init code. 


Set 


to 0 here only to avoid uninitialized variable warnings. 


FindFile: PUBLIC PROC [ 
directory: NSFi1e.Hand Ie, 

FileNanie: NSString. St ring <- [NIL. 0, of, 

type: NSFile,Type * StarFi1eTypeDefs.unspecified1 

RETURNS [file: NSFiHandle] - f 

mterList: ARRAY [0..2) OF NSF I le . F i 1 ter - [ 

[ equal[[name[fileName]]]], 

[equal[[type[type]]]] 

filter: NSFile.Filter; 


SELECT TRUE TROM 

(type = StarFileTypeDefs.unspecified) AND (fileName > [Nil , 0 0]) => 
(type » StarFileTypcDefs,unspecified) AND fileName # (NIL, o, o] => f 
type # StarF i leTypeDefs .unspecified => filter <- f i 1 terListdl ■ 

ENDCASE x> filter <■ f 11 terL i st[0] ; 


RETURN [NSF 1 1 e .nul1 Handle] ; 
liter <- [and[DESCRIPTOR[f i IterList]]] 


file r NSFi I e . null Hand I e; 
file *• NSF i 1 e . F i nd[ 
directory: directory, 

Scope: [filter: filter] ! 

NSFile.Lrror => IF error = [access]'f i I eNo tFound ] ] THEN CONTINUE ]: 


«GetFi leName; PUBLIC PROC [file: NSF i 1 e . Handl e, 
ar: NSFi1e■AttributesRecord e TRASH; 
rb: XString.ReaderBody; 


zone: UNCOUNTED ZONE] RETURNS [s: XString.Reader] 


{ 


NSFile,GetAttributes[file, [interpreted; [name: TRUE]], flarl: 
rb *■ XString. FromNSStri ng[ar. name] : 
s *- @ rb : 

NSFile,ClearAttributes[@ar]; 


GetycMin: PROC RETURNS [min: INTEGER] = [ 

jstar: LONG POINTER TO BOOLEAN e Atom.GetProp[ 

onto: multiNational, prop: oxtendedLanguage1.value: 
min r (IF jstarr THEN 5G ELSE 18) *-2; 


LegalScWnFromSrt: PUBLIC PROC [srt: RgnDefs.Srt] RETURNS [RgnOefs Sr] f 
OPEN srt.sc: i 

xc «■ MIN[xc . screenWidth - srt. rs.mth]: 
xc <- MAX[o, xc - (xc MOD 2)]; --even 

yc «- MIN[yc, screenlleight - srt.rs.ht]; 
yc r MAX[ycMin, yc - (yc MOD 2)]; --even 
RETURN [srt.sc]: 


Init: PROC = ( 

multiNational <- Atom.MakeAtom ["MultiNational" L]; 

tendedLanguage <- Atom.MakeAtom ["ExtendedLanquaqe"Ll ■ 
ycMin *- GetycMi n[] ; 


Too 1Uti1itiesPack.mesa 


7-Aug 87 16:37:18 PDT 



rnit[J; 

END. -ToolUtilitiesPack 

LOG (date - person - action) 

3-Jun-84 15:58:17 - Walden - OS5.0 release version 1 
9-Mar-85 10:24:40 - Marks - Update to OS6. 

27-Mar-85 16:26:14 - Marks - Use MultiNational instead of Mu 1tiNatiDefs 
/-Aug-87 16:35:35 - Marks - remove GetFileName 
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-- File: SpellIngCheckerUtilPack,mesa - last edit: 

— Walden 27-Mar-87 17:36:42 

-- Maybury,ES 9-Apr-86 13:43:26 

— Marks.ES 12-Sep-85 14:43:11 

-- Copyright (C) 1985, 1986, 1987 by Xerox Corporation. All rights reserved. 

DIRECTORY 

ApplIcatlonFolder USING [FlndDescrlptlonFIle, FromName], 

BWSZone USING [shortLIfetlme], 

CharDefs USING [chsetRoman, Roman], 

DocInterchangeDefs USING [AppendNewParagraph, AppendText, Doc, DocObject, FlnlshCreation, StartCreatlon], 

DocSpeclalDefs USING [ClearCllentsEditedFlag, EdltedFlaglD, GetCllentsEdltedFlag], 

DocumentDefs USING [DocFromlzn, Handle ], 

DocUtllDefs USING [subtypeBlankDoc] , 

HashTableLexiconDefs USING [flleType, SpacelnadequateCannotEnumerate], 

HashTableTempLexIconDefs USING [ 

OpenTemp, CloseTemp, AddTempWord, LookUpTempWord, Value, ValueFreeProc], 

I.exIconDefs USING [CreateLexIcon, f 1 leAttrType, GetFI1eAttrs, IsCurrent, LexIconFIleAttrs, LexIconHandle, LexIconlsFul1, LexiconType, 
WordProc], 

NSFIle USING [Attribute, Attributes, AttrlbutesProc, AttrlbutesRecord, ChangeAttrlbutes, ClearAttrlbutes, Close, Delete, Error, 
ExtendedAttrlbuteType, Filter, GetAttrlbutesByName, GetReference, Handle, List, Move, nullHandle, nul1 Reference, OpenByReference , 
Reference, Type, Words], 

NSStrlng USING [FreeStrlng, String, StrlngFromMesaString], 

OptionFIle USING [EntryEnumProc, EnumerateEntrles, GetStrlngValue], 

«PCLex1conFileTypeDefs USING [USEngl1shSystemLexIcon], 

PCUtnItyDefs USING [CheckLexIconFIles] .» 

ProductFactorlng USING [Enabled], 

Prototype USING [Find], 

PrototypeExtra USING [Add], 

SchemaDefs USING [GetRootCs, Lschema, IschemaNIl], 

SelectlonDefs USING [DeselectCs], 

SpellIngCheckerDefs USING [checkCtxt, CheckCtxt, ClearFdbkParms, DlsplayAttrs, dlsplayAttrType, LexIconDataLlst, LexiconDlsplayAttrs, 
LexIconList, LptLexIconData, LptLexiconDataLlst, ReplaceContlnueWIthStart, SCScanCtxt, StopAlternatlvesGeneratlon, WnDlsplayAttrs] , 
Spel1IngCheckerMessageDefs USING [GetHandle, keySCEmptyLexicon, keySCLexiconFolder, keySCWordsListedlnDoc] , 

StarDesktop USING [AddReferenceToDesktop , GetCurrentDesktopFIle], 

StarF11eTypeDef$ USING [folder], 

StarPFOptlons USING [starSpell1ng], 

System USING [gmtEpoch, GreenwIchMeanTIme], 

ToolUtllItlesDefs USING [LegalScWnFromSrt], 

TxtDefs USING [textSegmentNil], 

TxtEdltDefs USING [ClearTextSegment] , 

TxtScanDefs USING [PopAllEnum, ReadonlyWordFlags, ScanCtxt, WIDEN, WordFlagsObject], 

TextUtllDefs USING [BytesSIze, CopyToBytes, Rdr, ResetWrlter], 

XMessage USING [Get, Handle], 

XFormat USING [Number, Object, UnsIgnedDecImalFormat, WrlterObject], 

XStrlng USING [Bytes, ByteSequence, Character, CopyReader, emptyContext, 

FreeReaderBytes, FromChar, FromNSStrlng, FromSTRING, NSStrlngFromReader, Reader, 

ReaderBody, unknownContext, vanlllaContext, WrlterBody, WrlterBodyFromSTRING], 

XTIme USING [Append, Current]; 

SpellIngCheckerUtilPack: PROGRAM 

IMPORTS ApplIcatlonFolder, BWSZone, CharDefs, DocInterchangeDefs, DocSpeclalDefs, DocumentDefs, HashTableLexIconDefs, 
HashTableTempLexIconDefs, LexIconDefs, NSFIle, NSStrlng, <<PCUt11ItyDefs, >>0pt1onF11e, ProductFactorlng, Prototype, PrototypeExtra, 
SchemaDefs, SelectlonDefs, Spel1IngCheckerDefs, Spel1IngCheckerMessageDefs, StarDesktop, ToolUtllItlesDefs, TxtEditDefs, TxtScanDefs, 
TextUtilDefS, XFormat, XMessage, XStrlng, XTIme 
EXPORTS SpelllngCheckerDefs 
SHARES SelectlonDefs, XStrlng = 

BEGIN OPEN SpelllngCheckerDefs, Spel1IngCheckerMessageDefs, TxtDefs, TxtScanDefs, TextUtllDefs, XF: XFormat, XS: XStrlng; 

Bug: SlGNAL[Bugtype] = CODE; 

Bugtype: TYPE - {impossible}; 

--TYPES 

MakeDocCtxt: TYPE = LONG POINTER TO MakeDocCtxtObject; 

MakeDocCtxtObject: PUBLIC TYPE = RECORD [ 
flleDoc: NSFIle.Handle, 
doc: DocInterchangeDefs.Doc, 
unused: ARRAY[0..16) OF WORD 
]; -- concrete type cloned from TextUtllPack 

Wordltem: TYPE * LONG POINTER TO WordltemObject; 

WordltemObject: TYPE = RECORD[ 
bytes: XS.Bytes, 
length: CARDINAL, 

flagsObject: TxtScanDefs.WordFlagsObject]; 

-- CONSTANTS 

amerEngSysLexName: NSString . String = NSStrlng . Str1ngFromMesaStr1ng['’Amer1canEngl lsh’*L] ; 
h: XMessage.Handle = Spel1IngCheckerMessageDefs.GetHandle[]; 
newllneChar: XS.Character «■ LOOPHOLE[CharDef s . Roman[newL1 ne]] ; 
rbNewLlne: XS. ReaderBody «• XS.FromChar[@newLineChar]; 

ScEdltedFlaglD : DocSpedal Def s . Ed 1 tedFl agID = 0; 
shortZone: UNCOUNTED ZONE » BWSZone.shortLIfetlme; 


VARIABLES 

PROCEDURES 


ClaarHostDocCs: vPtlBLIC PROC = { 

OPEN c: chej^txt; 

-- Get lsohema from doc 
IF c.dOf/# NIL THEN { 

rood&s: SchemaDefs.Lschema ♦ SchemaDefs.GetRootCs[].lschema; 
IF rootCs # SchemaDefs.IschemaNIl 

AND DocumentDefs.DocFromIzn[rootCs.Izn] a c.doc THEN 
/ SelectlonDefs.DeselectCs[]; 

}: 
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CloseLexIcons: PUBLIC PROC/RETURNS [sysLexSelectedForLookup: BOOL *■ FALSE] = { 
OPEN c: checkCtxt; ' 

FOR i: CARDINAL IN [0..c.1 exicons.nLexIcons) DO 

IF c.lex1consf>].systemLex AND c,lex1cons[i].lookup THEN 

—***TTT / 

sysLexS&lectedForLookup *■ TRUE; 

4x1eons[1].lexicon » NIL THEN 
SseLex1con[@c.lex1cons[1]]; 
ifDLOOP; 


CloseLexIcon: PROC [lexData: LptLexIconData] 3 { 
cllsplayAttrlbutes : D1 spl ayAttrs. lexicon ; 
uttrLIst: ARRAY [0..1) OF NSF11 e.Attribute <- [ 

[extended[type: SpellIngCheckerDefs.dlsplayAttrType, 
value: DESCRIPTOR[@dlsplayAttributes, 

SIZE [DIsplayAttrs.lexicon], WORD]]]]: 

lexData.lexicon.close[lexData.lex icon]; 
lexData.lexicon «■ NIL; 

IF ~1exData.systemLex THEN { 

--set display attributes here 
dlsplayAttributes «• [var: lexicon^ 
selectedForLookUp: lexData.lookUp, 
selectedForEdlt: lexData.edit]]; 
NSF11e.ChangeAttr1butes[lexData.f11e. DESCRIPTOR[attrL1st]]; 
}; 

NSF11e.Close[ lexData.file]; 
lexData.file <- NSF11 e.nullHandle ; 

}: 


--assumes all lexicons are properly stamped... 

CreateLexIconLists: PUBLIC PROC [systemLexSelectedForLookUp: BOOL, c: Spel1IngCheckerDefs.CheckCtxt] = { 
internalName : XStrlng . ReaderBody «■ XStrlng. FromSTRING["Spe11 Ing Checker"L]; 
applFolderRef: NSFIIe.Reference = Appl1cationFolder.FromName [©Internal Name]; 
applFolder: NSF11e.Handle; 
nAllocated: CARDINAL <- 10; 
nLexIcons: CARDINAL <- 0; 

lexicons: LptLexlconDataLlst <- c.zone.NEW[Lex1conDataL1st[nAllocated]]; 
system: BOOL FALSE; 

extendedSelectlons: ARRAY[0..2) OF NSFIIe.ExtendedAttributeType * [LexIconDefs.flleAttrType, Spel1IngCheckerDefs.dlsplayAttrType]; 
adf; NSFIIe.Reference; 

sectlonName: XStrlng .ReaderBody «- XStrl ng. FromSTRING ["System Lexicons’^]; 

AddSystemLexiconFromEntryName: OptionFIle.EntryEnumProc a { 

— Internal name = entry name 

InternalNameNS: NSString.String * XStrlng.NSStrlngFromReader[entry, BWSZone.shortLIfetlme]; 

AddSystemLexIconFromUserName: PROCEDURE [value: XStrlng.Reader] = { 
attributes: NSFIIe . AttrlbutesRecord <- TRASH; 

NSF11e.GetAttributesByName[ 
directory: applFolder, 
path: InternalNameNS, 

selections: [Interpreted: [fllelD: TRUE, service: TRUE], 
extended: DESCRIPTORfextendedSelactions]], 
attributes: ©attributes 
! NSFIIe.Error *> GOTO SklpThlsOne]; 

AddLex1con[attrlbutes: ©attributes, userName: value, system: TRUE]; 

NSF11e.ClearAttrlbutes[©attributes]; 

EXITS 

SklpThisOne *> NULL; 

}; --AddSystemLexIconFromUserName 

0pt1onF11e.GetStr1ngValue[ 

section: ©sectlonName, entry: entry, callBack: AddSystemLexIconFromUserName, 

Index: 0, file: adf]; 

NSString.FreeString[BWSZone.shortL1fetime, InternalNameNS]; 

}; --AddSystemLexiconFromEntryName 

— needs attributes needed by AddLexicon, plus 'name' 
userCtnrLIstProc: NSF1le.AttrlbutesProc = { 

userName: XStrlng.ReaderBody *■ XStrlng .FromNSStrlng[attributes .name] ; 

AddLex1con[attributes: attributes, userName: ©userName, system: FALSE]}; 

-- needs fllelD, service, and extended selections: 

AddLexicon: PROC [attributes: NSFIIe.Attributes, userName: XStrlng.Reader, system: BOOL] = ( 
flleAttrs: LONG POINTER TO LexiconDefS.LexIconFIleAttrs; 
dlsplayAttrs: LexIconDIsplayAttrs; 

IF attributes.extended = NIL OR attributes.extended[0].value = NIL THEN RETURN; 

flleAttrs * LOOPHOLE[BASE[attr1butes.extended[0].value]]; 
dlsplayAttrs «■ IF (attributes .extended[l].value = NIL) 

OR LENGTH [attributes.extended[l].value] # SIZE[D1splayAttrs.lexicon] THEN NIL 
ELSE LOOPHOLE[BASE[attributes.extended[l].value]]; 

IF nLexIcons = nAllocated THEN { 

tempLexIcons: LptLexlconDataLlst <- c.zone .NEW[Lex1conDataL1st[(nAllocated «- (nAllocated+5))]] ; 

FOR 1: CARDINAL IN [0.. nLexIcons) DO 
tempLex1cons[1] <- lex1cons[l]; 
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ENDLOOP; 

c.zone.FREE[@1ex icons]; 
lexicons «■ tempLexicons; 


lex1cons[nLex1cons] «• [ 

ref: [attributes.f11elD, attributes.service], 

File: NSFIle.nullHandle, 

name: XS.CopyReader[userName, c.zone], 

lexicon: MIL, 

nWords: 0, 

systemLex: system, 

lookup: SELECT TRUE FROM 

system a > systemLexSelectedForLookUp, 

(dlsplayAttrs = NIL) -> FALSE, 

ENOCASE => dlsplayAttrs.selectedForLookUp, 
edit: SELECT TRUE FROM 

system, (dlsplayAttrs ■ NIL) => FALSE, 

ENOCASE => dlsplayAttrs.selectedForEdlt 

]S 

nLexIcons <■ nLexIcons + 1; 

}: --AddLexIcon 

IF c.userLexIconCtnr # NSFIle.nullHandle THEN 
NSF11e.LIst[d1rectory: c.userLexIconCtnr, 
proc: userCtnrLIstProc, 

scope: [filter: [equal[[type[value: HashTableLexIconDefs.flleTypo]]]]], 
selections: [ 

Interpreted: [fllelD: TRUE, service: TRUE, name: TRUE], 
extended: DESCRIPTOR[extendedSelectio ns]]]; 

IF applFolderRef # NSFIle.nulIReference THEN { 

IF (applFolder <- NSFl 1 e.OpenByReference [applFolderRef]) # NSFIle.nullHandle THEN { 
adf «■ Appllcat1onFolder.F1ndDescr1pt1onF11e[applFolder]; 

IF adf » NSFIle.nul1 Reference THEN 
OptlonFIle.EnumerateEntr1es[ 

QsectlonName, AddSystemLexIconFromEntryName, adf]; 

NSFIle.Close[applFolder]; 

}; 


IF c.lexicons = NIL 

OR (c.lexicons.nLexIcons # nLexIcons) THEN { 

IF c.lexicons 0 NIL THEN DestroyLexIconLIsts[]; 
c.lexicons «■ c.zone.NEW[Lex1conDataL1st[nLex1cons]]; 
c. lexIconsEdlt *■ c.zone.NEW[Lex1conL1$t[nLexicons]]; 
c.lexIconsLookUp «• c.zone.NEW[Lex1conL1st[nLex1consj]; 
}: 


FOR 1: CARDINAL IN [0..nLexIcons) DO 
c.lex1cons[1] <- lex1cons[1]; 
ENDLOOP: 

c.zone.FREE[Qlex Icons]; 

}: 


CreatePalrLIst: PUBLIC PROC [nPalrsMax: CARDINAL, z: UNCOUNTED ZONE] RETURNS [LexiconDefs.Lex 1conHandle] 3 { 
RETURN [HashTableTempLexIconDefs.OpenTemp[ 
nEntriesMax: nPalrsMax, 
hashTableType: ordinary, 
sizeValues: SIZE[WordItemObject], 
valueFreeProc: PalrLIstFreeProc, 
z: *]]i 

}: 


PairllstFreeProc: HashTableTempLexIconDefs.ValueFreeProc 3 { 
wltem: Wordltem = LOOPHOLE[value] ; 

--need cllentCtxt for temp lexicons too 
checkCtxt.zone.FREE[Owl tern.bytes]; 

}; 


OestroyPalrLIst; PUBLIC PROC [list: LexIconDefs.LexiconHandle] * { 
HashTableTempLexIconDefs.CloseTemp[list]; 


LookUpInPalrLlst: PUBLIC PROC [list: LexIconDefs.LexiconHandle, word: XS.Reader, wordFlags: TxtScanDefs.ReadonlyWordFlags] RETURNS 
[found: BOOL, associate: XS.ReaderBody, assoclateFlags: TxtScanDefs.ReadonlyWordFlags] - { 
wltem: Wordltem; 

[found, wltem] *• HashTabl eTempLexIconDef s . LookUpTempWord[l 1st, word, wordFlags]; 

IF found THEN [ 
associate «■ [ 

context: XS.vanll1aContext, 
limit: wltem.length , 
offset: 0, 

bytes: wltem.bytes]: 
assoclateFlags <- Qwltem.flagsObject; 

}: 

}; 


AppendNWordsAndTIme: PROC [doc: DocInterchangeDefs.Doc, nWords: LONG CARDINAL] = { 
tabChar: XS.Character <- LOOPHOLE[CharDef s .Roman[tab]] ; 
rb: XS.ReaderBody <- XS. FromChar[@tabChar] ; 

msgWordsLIsted: XS.ReaderBody «• XMessage.Get[h, keySCWordsLIstedlnDoc]; 
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IsTemp: LONG STRING = [100]; 

wb: XS.WrlterBody 4- XS.Wr1terBodyFromSTRING[s: IsTemp, homogeneous: TRUE]; 
time: System .GraenwIchMeanTIme <- XTime .Current[] ; 

-- put the current date/time in the document's header 
XTime.Append[@wb, time]; 

DocInterchangeDefs.AppendText[[doc[doc]], TextUtliOefs.Rdr[@wb], XS.emptyContext]; 

DocInterchangeDefs.AppendText[[doc[doc]], @rb, XS.emptyContext]; 

DocInterchangeDefs.AppendText[[doc[doc]], Orb, XS.emptyContext]; 

TextUtilDefs.ResetWr1ter[@wb]; 

{o: XF.Object 4> XF.Wr1terObject[0wb]; 

XF.Number[@o, nWords, XF.UnsIgnedDecimalFormat]; 


DocInterchangeDefs.AppendText[[doc[doc]], Rdr[@wb], XS.emptyContext]; 

DocInterchangeDefs.AppendText[[doc[doc]], OmsgWordsListed, XS.emptyContext]; 

}; — AppendNWordsAndTIme 

MakeDoc: PUBLIC PROC [lexicon: LexIconDefs.LexIconHandle, name: XStrlng.Reader] RETURNS [ok: BOOL] * { 
flleDoc: NSFile.Handle: 
doc: DodnterchangeDefs.DOC; 

<<propose: sort TStrlngs (small, fixed size); the prefix Is known to not change and be chsetRoman; the bytes are known to be constant, 
need to fix relationship with lexicon to keep this knowledge private to lexicon 

TString: TYPE = RECORD [offset, length: CARDINAL]; 

» 

IF (doc +• DocInterchangeDefs .StartCreat1on[] .doc) = NIL THEN 
RETURN [ok: FALSE]; 

AppendNWordsAndT1me[doc, lexicon.getNWords[lex Icon].nWordsCur]; 

DocInterchangeDefs.AppendText[[doc[doc]], DrbNewLine, XS.emptyContext]; 

AddWordsToDoc[lex1con, doc]; 

flleDoc *• DocInterchangeDefs. F1n1shCreat1on[@doc] .docFile ; 

{nsName; NSString,Str1ng « XStrlng.NSStrlngFromReader[name, shortZone]; 
attrLIst: ARRAY [0..1) OF NSFIle.Attribute + [[name[value: nsName]]]; 
refDoc: NSFIle. Reference 4- NSFIle ,GetReference[f 1 leDoc] : 
dtReference: NSFIle.Reference = StarDesktop.GetCurrentDe$ktopF11a[]; 
dtHandle: NSFIle.Handle 4- NSF1 le .OpenByReference[dtReference]; 

NSFIle.Move[flie: flleDoc, destination: dtHandle, attributes: DESCRIPTOR[attrL1st]]; 

NSFIle.C1ose[f11eDoc]; 

NSFile.Close[dtHandle]; 

StarDesktop.AddReferenceToDesktop[reference: refDoc] ; 

NSString.Freestring[shortZone, nsName] ; 

}J 


RETURN [ok: TRUE]; 

}; --MakeDoc 

AddWordsToDoc: PROC [lexicon: LexIconDefs.LexIconHandle, doc: DocInterchangeDefs.Doc] = { 
-- we will sort ReaderBodies (more efficient to sort TStrlngs?) 

AddWordToDoc: LexIconDefs.WordProc a { 

DocInterchangeDefs.AppendNewParagraph[[doc[doc]]]; 

DocInterchangeDefs.AppendText[[doc[doc]], word, XS.unknownContext]; 

}; 


lexicon .enumerate[1exicon, AddWordToDoc — enum. is supposed be in sort-order 
<<Someday we should inform the user If this happens:» 

\ HashTableLexiconDefs.SpacelnadequateCannotEnumerate = > RESUME]; 

}: 


SetDocContext: PUBLIC PROC [doc: DocumentDefs.Handle] = { 

OPEN c: checkCtxt; 

If doc - c.doc THEN RETURN; 

StopAlternat1vesGeneration[]; 

IF c.doc H NIL THEN { — clear old text context 

scSC: SCScanCtxt = 0c.scScanCtxtObject; 

IF scSC.wordScanCtxtObject.scanCtxtObject.ee # NIL THEN { —in the middle of scan 

TxtScanDefs.PopAl1Enum[WIDEN[scSC]]; 

}: 


ReplaceCont1nueW1thStart[]; 

IF scSC.wordScanCtxtObject.ts # textSegmentNi1 THEN 
TxtEdltDefs.ClearTextSegment[@scSC.wordScanCtxtObject.ts]; 

ClearFdbkParms[]; 

y> 

c.doc 4 - doc: 

IF c.doc H NIL THEN SetDocNotEdlted[c.doc]; 

}: 


SetDocNotEdlted: PUBLIC PROC [doc: DocumentDefs.Handle] = { 

DocSpeclalDefs.ClearC11entsEd1tedFlag[doc, scEdltedFlagID] }; 

SetPalr: PUBLIC PROC [list: LexIconDefs.LexIconHandle, word: XS.Reader, wordFlags: TxtScanDefs.ReadonlyWordFlags, associate: XS.Reader, 
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associateFlags: TxtScanDefs.ReadonlyWordFlags] RETURNS [ok: 800L <- TRUE] = { 
added: BOOL; 
wltem: Wordltem; 

assoclateLength: CARDINAL = BytesS1ze[assoc1ate]; 

--Includes Initial chset change If not Roman 

[added, LOOPHOLE[wItem, HashTableTempLexIconDefs,Value]] *■ HashTableTempLexIconDefs.AddTempWord[l1st, word, wordFlags 
!Lex1conDef$.Lex1conIsFull => GOTO notOK]; 

IF added THEN 

wltem.bytes <- checkCtxt.zone.NEW[XS.ByteSequence[assoc1ateLength]] 

ELSE { --already there 

wordsAvall: CARDINAL a SIZE[XS.ByteSequence[wItem.length]]; 
wordsNeeded: CARDINAL = SIZE[XS.ByteSequence[assoc1ateLength]]; 

IF wordsAvall # wordsNeeded THEN { 
checkCtxt.zone.FREE[@wItem.bytes] ; 

wltem.bytes «- checkCtxt.zone.NEW[XS.ByteSequence[assoclateLength]]; 

}; 

}; 


CopyToBytes[to: wltem.bytes, from: associate, n; assoclateLength]; 

wltem.length *- assoclateLength: 
wltem.flagsObject «■ assoclateFlags^; 
ok 4- TRUE; 

EXITS 

notOK => RETURN [ok: FALSE]; 

}; 


IJserEdltedDoc: PUBLIC PROC [doc: DocumentDefs.Handle] RETURNS [BOOL] = { 
RETURN[DocSpec1alDefs.GetCllentsEdltedFlag[doc, scEdltedFIagID]] }; 

- PRIVATE 

•--all lexicons and files had better be closed 
DestroyLexIconLlsts: PROC * { 

OPEN c: checkCtxt; 

FOR 1: CARDINAL IN [0..c.1 ex Icons.nLexicons) DO 

XStr1ng.FreeReaderByte$[c.lexicons[1].name, c.zone]; 

ENDLOOP; 

c.zone.FREE[@c.lexicons]; 
c.zone.FREE[@c.lex IconsEdit]; 
c.zone.FREE[@c.lex IconsLookUp]; 

}: 


OpenUserLexIconCtnr: PUBLIC PROC RETURNS [file: NSF11e.Handle, lastModlfledOn: System.GreenwIchMeanTIme. dlspAttrs: DIsplayAttrs.wn] 

{ 

defaultAttrs: DlsplayAttrs.wn = [ 
var; wn[ 

scWn: ToolUt1Ht1esDefs.LegalScWnFromSrt[[sc: [641, 22], rs: [0, 0]]], 
rsBody: [350, 200], 
scope: all, 
autoCorrect: FALSE, 

IncludeAnchoredFrames; FALSE, 
sysLexSelectedForLookUp; TRUE]]; 

extendedAttrs: ARRAY [0..1) OF NSF ile. ExtendedAttr ibuteType «• [ 
displayAttrType]; 

found: BOOL «■ FALSE; 

rbLexIconFolder: XS.ReaderBody *• XMessage.Get[h, keySCLexIconFolder] ; 

lexIconCtnrName: NSStrlng.String = XS.NSStr1ngFromReader[0rbLex1conFolder. checkCtxt.zone]; 
f11terLIst: ARRAY [0..2) OF NSFile.Filter [ 

[equal[[name[lex1conCtnrName]]]], 

[equal[[type[StarF11 eTypeDefs.folder «lex1conFolder>>]]]] 

]; 

dtReference: NSFile.Reference = StarDesktop.GetCurrentDesktopF11e[]; 
dtHandle: NSFile.Handle; 

LlstProc: NSFile.AttrlbutesProc = { 

file <• NSFile.OpenByReference[[attributes .fllelD, attributes . service]] ; 
lastModlf ledOn *- attributes .modlfiedOn; 
dlspAttrs «- IF (attributes.extended * NIL) 

OR (attributes.extended[0].value = NIL) 

OR (LENGTH[attr1butes.extended[0].value] # SIZE[DisplayAttrs.wn]) THEN defaultAttrs 
ELSE 

LOOPHOLE[BASE[attributes.extended[0].value], WnDIsplayAttrsjt; 
found <■ TRUE; 

RETURN [continue: FALSE]; 

}; --LlstProc 

dtHandle +■ NSFile.OpenByReference[dtReference] ; 

NSFile.LIst[d1rectory: dtHandle, 
proc: LlstProc, 

selections: [Interpreted: [fllelD: TRUE, service: TRUE, modlfiedOn: TRUE], extended: DESCRIPTOR[extendedAttrs]], 
scope: [filter: [and[DESCRIPTOR[f11terLIst]]]] ]; 

NSF11e.Close[dtHandle]; 

IF -found THEN { 

file * NSFile.nullHandle; 

1 astModlf ledOn «- System.gmtEpoch ; 
dlspAttrs *■ defaultAttrs; 

}: 


NSStrlng.FreeStr1ng[checkCtxt.zone. 1 ex1conCtnrName]: 
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In It: PROC = { 

IF ProductFactor1ng.Enabled[StarPFOpt1ons.starSpelling] THEN 
BEGIN 

reference: NSFIle.Reference: 
lex: NSFile.Handle: 

rbLexIconName: XS.ReaderBody <- XMessage.Get[h, keySCEmptyLexicon] ; 
emptyLexIconName: NSString.Strlng = XS.NSStrlngFromReader[@rbLex1conName, shortZone]: 

« — Inlt system lexicons 

PCUtilItyDef s.CheckLex1conF11es[amerEngSysLexName]: 

--generalize for multiple system proximity-format lex1cons» 

--inlt prototype private lexicon 
reference *■ Prototype.F1nd[ 

type: HashTableLexiconDefs.fileType, version: 1, subtype: OocUtilDefs.subtypeBIankDoc]; 
lex «- 

IF reference ■ NSFile.nullReference THEN NSFile.nuilHandle 
ELSE NSFile.OpenByReference[reference: reference]: 

IF lex = NSFile.nuilHandle THEN { 
lex <- LexIconDefs.CreateLex1con[ 

hashTable, NSFile.nuilHandle, emptyLexIconName, 1000, TRUE]: 

PrototypeExtra.Add[ 

file: lex, version: 1, subtype: OocUtilDefs.subtypeBlankDoc]; 

} 

ELSE 

IF -LexiconDefs.IsCurrent[LexiconDefs.GetFl1eAttrs[lex]] THEN { 

NSFile.Delete[lex]; 

lex <- LexIconDefs.CreateLexicon[ 

hashTable, NSFile.nuilHandle, emptyLexIconName, 1000, TRUE]; 

PrototypeExtra.Add[ 

file: lex, version: 1, subtype: DocUtllDefs.SubtypeBlankDoc]: 

}! 

NSString.Freestr1ng[shortZone, emptyLexIconName]: 

IF lex » NSFile.nuilHandle THEN NSFile.Close[lex]; 

END; 


}; 


— MAINLINE 
Inlt[]: 

END. — Spel1IngCheckerUtllPack 

LO(i (date - person - action) 

5--Jun-84 16:45:48 - Walden - OS5.0 release version 1 

29- Jun-84 10:51:49 - Walden 

17-*Jul-84 19:14:49 - D.J. Lewis - Tie Initialization to FeatureDefs product factoring flag. 

26--Ju1-84 12:11:08 - D.J. Lewis - Replace XTIme with Star time service (MessageDefs.GetTImeMsg). 

17- Aug-84 15:34:23 - Walden - Stop alternatives generation In SetDocContext - this SHOULD be done anyway, and if it isn’t, causes process 
Interference in the unMONITORed PCMaln lexicon. This fixes lurking bug when document is closed or paginated or something moved/deleted 
when In the middle of checking. 

9--Mar-85 10:22:45 - Marks - Update to 0S6. 

9-Mar-85 10:22:45 - Marks - Fix UserEditedDoc, SetDocNotEdited with calls to DocSpeclalDefs. 

13-Mar-85 15:49:20 - Marks - Make sure that only one Empty Lex is added to prototype folder when needed and previous versions are 
deleted. 

30- Apr-85 11:14:38 - Marks - Get Dictionaries from Application Folder. 

7-May-85 14:49:38 - Marks - DocInterchangeDefs returns two values now. 

7-Aug-85 11:20:15 - Marks - AR 17975: CreateLexIconLlsts - when allocate larger data structure copy over data contained in It. 

ll-Sep-85 13:12:29 - Marks - AR 19933: MakeDoc - use default place. 

18- Dec-85 16:35:40 - Maybury - AddWordToDoc: Using para, per word to Improve MakeDoc performance. 

19- Dec-85 16:08:47 - Maybury - AddWordsToDoc: Cease using GSortDefs (due to bugs in GSortPack; also for perf. gain); rely on 
lexicon.enumerate to produce a SORTED enumeration. 

30-Jan-86 11:44:07 - Maybury - Inlt: moved lexicon Icon initialization to HashTableLexIconPack. 

3-Feb-86 13:57:22 - Maybury - Adopted HashTableLexlconDefs.flleType (vs. hackLexIcon). AddWordsToDoc: catch <<and RESUME without 

comment» SpacelnadequateCannotEnumerate. 

9-Apr-86 13:42:20 - Maybury - SetDocContext: conform to new SCScanCtxtObject. 

16-Apr-86 16:31:21 - Walden - use PCLexiconFIleTypeDefs.USEngl1shSystemLexicon for file type of system USEnglish lexicon 
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NewFetch.me 
l-Feb-86 18:01:26 


I have an Idea In order to decrease the microcode clicks when IB not empty refill occur In rum. I made the new rum that had new bytecode 
refill routine, but It was not stable. I'm not sure where is bad, since I've modified all place where IBDisp occurred. I show the new 
refill routine below, so, could you tell me where is bad. 

Thank you. 

//Toru 


New fetching routine: ( In ref11landtraps.me ) 


stEmpty: 

{ when we arrive here, the buffer Is empty, and the Ip Is pointing at the word to 
MAR 4- [IpHIgh, IpLow+O], Xbus «- uTImeToStabil Ize, XDIsp, 
templLow «■ 1, BRANCH [noStablllze, yesStablllza, 0£], 


be fetched} 
cl. at [400]; 
c2; 


yesStablllze: 

IB <- MD, IpLow IpLow + 1, GOTO [stab 111 zeNow], [adjust ip} c3; 


noStablllze: 

IB 4- MO, GOTO [stNotEmpty], 


stNotEmpty: 

MAR 4- IpLow «■ [IpHIgh, IpLow + templLow], Xbus «• uTlmeToStabl 1 ize. 

XDIsp, L3 +■ 0, cl, at [500]; 

stNotEmptyc2 .* 

A1waysIBDIsp. DISP2 [stabPaCarr], c2; 


[l}{no stabilization Is needed, page carry does not occur} 

IB +■ MD, IpLow *- IpLow - 1, DISPNI [bytecodes], c3, at [0, 4, stabPaCarr]; 

£2}{ this case Is special } 

£ stabilization Is needed, page carry does not occur} 

IpLow *■ IpLow - 1, DISPNI [bytecodes], c3, at [1, 4, stabPaCarr]; 


(3}{ no stablllzalon Is neede, page carry occurs } 

IpLow *■ IpLow + OFF + 1, c3, at [2, 4, stabPaCarr]; 

MAR [IpHIgh, IpLow + 0], Xbus 4* 0, XDIsp, GOTO [stNotEmptyc2], cl; 


{4}{ stabilization Is needed, page carry occurs } 

IpLow <■ IpLow + OFF + 1, CANCELBR [stabll IzeNow, OF], c3, at [3, 4, stabPaCarr]; 


Where : templLow = 1 whenever IBDisp occurs. 

uTImeToStabilIze = U45 because templLow = R4, so, MesaStateG(former U45) = U00. 
The stabilization Is needed when uTImeToStabilize = 1 rather than OFFFF. 


{1} ; It's normal case, so refill the bytecodes and IBDisp. 

[2} : most special case, do not refill the bytecode and IBDisp, since IBDisp can not be canceled. The stablllztlon Is executed when 
IBEmpty Refill occurs, In this case, we should think about the possibility that IBEmpty Trap occurs when the bytecode in IBO or IB1 
needs more 1 or 2 bytes, so I modified, see the routine below. 

{3} : just page carry occurs, adjust the Instruction pointer and try to fetch the bytecodes again. 

{4} : In this case, IBDisp is canceled, so the stabilization is executed first, and after It, refill the bytecodes. 


Fatal Error: 

templLow ErrnIBnStkp, ClrlntErr, CANCELBR [$. OF], cl, at [0]; 

FatalErrorSpIn: 

templLow <■ templLow LRotl2, c2; 

[] 4- templLow and OC, ZeroBr, c3; 

Xbus 4- uTImeToStabil Ize , XDIsp, BRANCH [IbTrap, otherTrap], cl; 

othorT rap: 

CANCELBR [ba11out3, OF], c2; 

ibT rap; 

LODIsp, BRANCH [noStabIBErr. yesStabIBErr, OE], c2 ; 

noStabIBErr: 

CANCELBR [balloutl, OF], c3; 


yesStabIBErr: 

IpLow 4- IpLow - 1, DISP2 [chkByteLen], 


{ It's strange that IB empty Error occured when byte length 3 1 } 
GOTO [ballout2], 


c3: { point the word to be fetched } 

cl, at [0, 4, chkByteLen]; 


NewFetch.me 


l-Feb-86 18:01:27 PST 



{- byte length =» 2 


} 


1bErr6yte2 • 

MAR «- [IpHIgh, IpLow + 0], 

IpLow <- IpLow + 1, Cln * pcie, CANCELBR [$. 0]. 
IB «- MD. IBPtr <- 1. GOTO [stabllIzeNow]. 


{- byte leongth - 3-} 

1bErrByte3: 

MAR *- [IpHIgh, IpLow +■ 0], XC2npcD1sp, 

IpLow «- IpLow + 1, BRANCH [pcOneInByte3, pcZeroInByte3. 


pcZeroInByte3: 

IB «• MD, GOTO [stabll IzeNow], 


pc0neln8yte3: 

18 <- MD, IBPtr <- 1, GOTO [stabll IzeNow], 


(- byte length = 4-} 

{ So far, we have no such byte code that It needs another 3 byte 
IbEfrByte4: 

GOTO [ballout2], 


cl, at [1, 4, chkByteLan]; 

c2; [ point theword to be fetched next } 

c3; 


cl, at [2, 4, chkByteLen]; 

OE], c2; { point the word to be Patched next } 


c3; 


c3; 

to exacute, so this case does not Implemeted yet.- bailout -} 

cl, at [3, 4, chkByteLen]; 
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{ ref11lAndTraps.me 

Instruction buffer refill and other trap handling code for Rum, the Dandelion Smalltalk-80 microcoded virtual machine, 
by P McCullough, J Trow, T Tokunaga 
l-Feb-86 17:16:19 

Copyright 1983, 1984, 1985, 1986 by Xerox Corporation. All rights reserved. } 


(Refill and Trap microcode for the Smalltalk Virtual Machine 
Introduction to the Refill microcode: 


As each Smalltalk bytecode Implementation nears completion, an IBDIsp is executed. The action that then occurs is summarized In the 
following table: 


Mesa Interrupt Pending No Mesa Interrupt Pending 


IB state 


full 

trap 

to 

location 

600 

branch to next macroinstruction Interpreter 

empty 

trap 

to 

1ocatlon 

600 

trap to location 400 

not empty 

trap 

to 

location 

700 

trap to location 500 


If a Mesa interrupt Is pending (locations 600 and 700), we pack up the Smalltalk Interpreter state and punt to Molasses, otherwise, we 
refill the Instruction Suffer and continue Interpreting bytecodes. The code at location 400 (empty Instruction Buffer) reads a word and 
loads It into the Instruction Buffer, then starts a read of the next word while simultaneously starting a dispatch on the first byte of 
the Instruction Buffer. If we have trapped to location 500 (non empty Instruction Buffer) we must read one additional word and load It 
Into the Instruction Buffer. 

The reader should note that we unconditionally refill the Instruction Buffer, even If the subsequent bytes are not needed. Thus, If the 
buffer is empty, we read two words even though we may never execute the last 3 bytes. We take this approach for simplicity and speed, 
but it does mean that we can potentially read a word beyond the end of the Object Space. This is not a problem if the Object Space is 
not at the end of the Smalltalk memory (e.g., you could place the Object Table after the Object Space, or simply make the last word of 
the Object Space unavailable for allocation). 


> 


MacroOef [AlwaysIBDIsp, (IBDIsp, IBPtr «- 1)] (same definition as In Mesa.df}; 


stEmpty: 

{ when we arrive here, the buffer Is empty, and the ip Is pointing at the word to be fetched } 
MAR [IpHIgh, IpLow+O], cl. at [400]; 

IpLow «■ IpLow + 1, c2; 

IB +• MD, GOTO [nextWord-stNotEmpty] , c3; 


stNotEmpty: 

{ when we arrive here, the buffer Is not empty, and 
ipLow «■ IpLow + 1, 

Ybus <■ uTImeToStabll Ize , ZeroBr, 

BRANCH [$, nextWord-stNotEmpty], 

stabllIzeNow: 

LO «■ uCodeRequestadStabll Izatlon , 

Noop, 

CALL [stabilize], 

otLow <- uActlveContextOop, 

stabllize-return]; 

temp3Low «- actlveAfterStabll Ize , 

Noop, 

uMakeVolatlleLInkage *• temp3Low, CALL [makeVolatl1e], 

temp2H1gh <- uRumRecordHlgh, 
temp2Low * uRumRecordLow, 


the ip Is one word short of pointing at the word to be fetched } 
Cl, at [500]; 
c2; 
c3; 


cl; 
c2; 
c3; 

cl, at [uCodeRequestadStabllIzatlon, 10, 

c2; 
c3; 

cl; 

cl, at [actlveAfterStabilize, 10, makeVolatlle-return]; 
c2; 
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{ 

Introduction to the Trap microcode: 

Certain conditions (Control Store parity errors, emulator memory errors, Mesa stackPoInter overflow or underflow, and IB-empty errors) 
causa traps to location 0. Currently we just hang for any of these errors: future Implementations probably want to take a more official 
action. The IB-empty error is useful in the Mesa emulator (where it is utilized to detect and handle page crossings), but In Smalltalk 
land It means that a coding error has been made and too many bytes have been fetched from the Instruction Buffer. 


} 

FatalError: 

templLow *■ ErrnIBnStkp, ClrlntErr, CANCELBR [$, OF], 
Q <- trapAtLocatlonO, GOTO [ba11out3], 


cl, at [0]; 
c 2; 


{ Edit history: 

2-Oct-85 18:31:14 Tokunaga.fx modify the routine for Mesa Interrupt 

30-$ep-85 17:09:40 Trow.pa convert to stretch format } 
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{ SmalltalkStataSaveAndRestore.me 

Emulator swapping code for Rum, the Dandelion Smalltalk-80 mlcrocoded virtual machine, 
by P McCullough, J Trow, T Tokunaga 
l-Feb -86 10:57:17 

Copyright 1983, 1984, 1986, 1986 by Xerox Corporation. All rights reserved. } 


getSmalltalkState: 

Q «■ uRumRecordHigh {retrieve the Rum Record address}, cl; 
temp3High + Q LRotO, c2; 
temp3Low 4 - uRumRecordLow , c3; 

(get the method cache address} 

MAR «• [temp3High, temp3Low + methodCacheLowOff set] , cl; 
CANCELBR [S, 0], c2; 
Q ♦> MD, c3; 

MAR 4 - [temp3High, temp3Low + methodCacheHighOffset], cl; 
uMethodCacheLow «■ Q, CANCELBR [$, 0], c2; 
Q <■ MD, c3; 

{get the Object Table address} 

MAR *• {temp3High, temp3Low + objectTableHighOffset], cl; 
uMethodCacheHIgh *> Q, CANCELBR [$, 0], c2; 
otHigh 4 - MD, c3 ; 


{get the oop of the active context, otmap it. save oop and base address} 
MAR 4 - [temp3High, temp3Low + activeContextOopOff set], 

LI 4- gettingActiveContextDuringlnterpreterSwap, 


CANCELBR [$, 0], 

OtLow 4 - MD, CALL [otMap2], 

0 4 * templHigh, 
otMap2-return]; 
uActiveContextHIgh «- Q, 

Q 4 - templLow, 

uActiveContextLow 4 - Q, 

Q 4 - otLow, 

uActiveContextOop <- Q, 

{get current Stack Pointer} 

MAR <- [temp3H1gh, temp3Low + stackPolnterLowOffset], 
CANCELBR [$, 0], 

StackLow 4 - MD, 

MAR 4 - {temp3H1gh, temp3Low + stackPointerHighOffset], 
CANCELBR {$, 0], 
stackHigh «- MD, 

{get Home Context Oop, otMap it, save its address} 
MAR 4 - {temp3H1gh, temp3Low + homeContextOopOffset], 

LI <- gettingSmall tal kState, 

CANCELBR [$, 0], 

OtLow 4 - MD, CALL [otMap], 


cl; 
c 2 ; 
c3; 

cl, at [gettlngActlveContextDurlnglnterpreterSwap, 10 , 

c 2 ; 
c3; 

cl; 
c 2 ; 
c3; 


cl; 
c 2 ; 
c3; 

cl; 
c 2 ; 
c3; 


cl; 
c 2 ; 
c3; 


uHomeLow 4 - templLow, 

Q 4 - templHigh, 
homeHigh 4 - Q LRotO , 

{get the oop of current receiver, save it and If It is not a 
MAR 4 - [temp3H1gh, temp3Low +■ recelverOopOffset], 
homeLow 4 . uHomeLow, CANCELBR [$, 0], 

OtLow 4 - MD, 

uTImeToStabil ize 4- 0, 
uRecelverOop 4 - otLow, YDlsp, 

DISP4 {stateTable, OC], 


cl, at [gettingSmalltalkState, 10, otMap-return]; 

c 2 ; 

c3; 

Smalllnteger, otMap It and save its address } 
cl; 
c 2 ; 
c3; 

cl; 
c 2 ; 

c3; {stretch3} 


getSmal!talkStateSmal1IntegerOO: 

MAR 4 - [temp3High, temp3Low + currentMethodOopOffset], 

LI 4- isSmallGettlngSmall tal kState, 

GOTO [getSmal1talkStateForSmal1Integer], cl, at [OC, 10, stateTable]; {stretch3} 


getSmal1talkStataOopOl: 

LI 4- isOopGettingSmalltalkState, GOTO [getSmalItalkStateForOop], cl, at [OD, 10, stateTable]; {stretch3} 


getSmal!talkStateOopll: 

LI 4 - IsOopGettingSmall tal kState, GOTO [getSmal! tal kStateForOop], 


cl, at {OF, 10, stateTable]; 


{stretch3} 


getSmal1talkStateOoplO: 

LI 4 - IsOopGettingSmall tal kState, GOTO [getSmal I tal kStateForOop], 


cl, at [OE, 10, stateTable]; 


{stretch3} 


getSmal1talkStateForOop; 
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Noop, 

c2; 


CALL [otMap], 

c3; 


Q 4- templHIgh, 

cl, at [ 

IsOopGettlngSmalltalkState, 10, otMap-return]; 

uRecelverHIgh +■ Q, 

c2; 


Q <- templLow, 

c3; 


{get the oop of the current method, otMap It, set up the machine's 
MAR *■ [temp3H1gh, temp3Low + currentMethodOopOffset], 

Instruction pointer 

registers} 

LI «■ IsSmal IGettingSmall tal kState , 
getSmal1talkStateForSmal11nteger: 

cl; 


uRecelverLow *• Q, CANCELBR [$, 0], 

c2; 


otLow +> MD, CALL [otMap], 

c3; 


Q 4- templHIgh, 

cl, at [• 

IsSmalIGettlngSmalltalkState , 10, otMap-return]; 

IpHIgh 4- Q LRotO, 

c2; 


IpLow ♦* templLow + objectHeaderSize , 

c3; 


uCurrentMethodHIgh 4* Q, 

cl; 


Q 4- templLow, 

c2; 


uCurrentMethodLow 4- Q, 

c3; 


MAR 4- [temp3H1gh, temp3Low + InstructlonPoInterOf fset], 

cl; 


CANCELBR [$, 0], 

c2; 


temp3Low 4- MD, 

c3; 



fixuplnstructlonPointer: 

{Upon entry, temp3Low must contain the number of bytes by which to adjust the instruction pointer. IpLow must be the base of the 
current compiled method. Either IpLow must be bumped by objectHeaderS Ize or tamp3Low must account for the object header by being 
overstated by the amount objectHeaderSlze*2} 

temp2Low <• RShlftl temp3Low {get word offset}, SE «■ 0, 

XC2npcD1sp {see what state pcl6 1s--we want It zero}, cI; 

IpLow <- IpLow + temp2Low {add in word offset}, 

BRANCH [flip. noFllp, OE], c2; 

flip: 

Cln 4- pc 16 {make It zero}, GOTO [pcl61sZeroNow], c3: 

noFllp: 

GOTO [pcl61sZeroNow], c3: 

pclGIsZeroNow: 

MAR <- [IpHIgh, 1pLow+ 0] {read a word of bytecodes}, cl; 

[] temp3Low {determine desired state of pcl6}, YDIsp. c2; 

IB MD {load up Instruction buffer}, BRANCH [leaveltBe, makeltl, OE], c3; 

makoltl: 

Cln <• pcl6, IBPtr 1, GOTO [offToSeeTheWIzard], cl; 

leaveltBe: 

GOTO [offToSeeTheWIzard], cl; 


offToSeeTheWIzard: 

{because the saving of the Mesa state left the Instruction Buffer empty and we then put In one or two bytes, the following IBDIsp 
will cause a trap to the refill code at stNotEinpty which will refill the Instruction Buffer and execute another IBDIsp that will 
take us to the Interpreter for the current bytecode} 


IpLow *• IpLow + 1, 

GOTO [nextWord-stNotEmpty]. 


c2; 
c 3; 


savoSmal1talkState: 

{we come here when Rum finds an unpleasant bytecode, or when a Mesa Interrupt has been set. Upon entry templLow should be: 1 
for a notYetlnvented bytecode, 0 for a Mesa Interrupt has occurred, and 2 for bytecode failure} 


Q <■ uRumRecordHIgh {retrieve the Rum Record address}, cl; 
temp3H1gh 4- Q LRotO, c2; 
temp3Low *■ uRumRecordLow, c3; 

{write the current stack pointer} 

MAR *• [temp3H1gh, temp3Low + stackPolnterLowOffset] , cl; 
MDR 4- stackLow, LOOPHOLE [wok], CANCELBR [$, 0], c2; 
Noop, c3; 
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MAR [temp3H1gh, temp3Low + stackPalnterHIghOffset], 
MDR 4- stackHIgh, LOOPHOLE [wok], CANCELBR [$, 0], 


cl; 
c2; 


{adjust the instruction pointer to make Molasses happy, then write the InstructlonPointer) 


ipLow «• IpLow - objectHeaderSIze, 

c3: 




temp2Low «■ uCurrgntMethodLow, 

cl: 




IpLow 4- IpLow - temp2Low, 

c2; 




IpLow «- LShlftl IpLow, SE 4- pcl6, 

c3; 




[] *• templLow, YDisp, 

cl; 




DISP4 [smalltalkState], LODlsp (In case of bytecode failure}, 

c2; 




CANCELBR [wrltelp. OF], 

c3, 

at 

[0. 

10, smalltalkState]; 

CANCELBR [wrltelp, OF], 

c3, 

at 

[1. 

10, smalltalkState]; 

templLow *■ 1 {tell Molasses to execute this bytecode}, 





DISP2 [IpAdjustment] (bytecode failed -- need to fix up 

inst ptr}, 




c3, 

at 

[2. 

10, smalltalkState]; 

GOTO [IpAdjusted], 

cl, 

at 

[0. 

4, IpAdjustment]; 

ipLow <- ipLow - 1, GOTO [IpAdjusted] 

cl, 

at 

[1. 

4, IpAdjustment]; 

IpLow ipLow - 2, GOTO [IpAdjusted] 

cl. 

at 

[2. 

4, IpAdjustment]; 

IpLow 4- ipLow - 3, GOTO [IpAdjusted] 

cl. 

at 

[3, 

4, ipAdjustment]; 

IpAdjusted: 





Noop, 

c2: 




Noop, 

c3: 




wrltelp: 





MAR 4- [temp3H1gh , temp3Low + InstructlonPolnterOffset], 

cl; 




MDR <- IpLow, LOOPHOLE [wok], CANCELBR [$, 0], 

c2: 




Noop , 

c3; 




MAR 4- [temp3H1gh, temp3Low + dlrectiveOffset], 

cl: 




MDR 4- templLow, LOOPHOLE [wok], CANCELBR [$, 0], 

c2; 




GOTO [restoreMesaState], 

c3; 





{todo — save current method oop} 


{ Edit history: 

2-Oct-85 18:22:40 
30-<iep-85 17:13:45 


Tokunaga.fx no IBDIsp is used when refill Smalltalk bytecode 
Trow.pa convert to stretch format } 
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-- Copyright (C) 1983 by Xerox Corporation. All rights reserved. 

-- EtherBooter.mesa, RXJ , ll-Jul-83 16:35:04 

NFS 10-Jun-86 10:42:13 adapted for OthelloTool 

DIRECTORY 

Boot USING [EthernetBootFileNumber, EthernetRequest], 

Heap USING [systemZone], 

HostNumbers USING [HostNumber], 

NSConstants USING [bootServerSocket], 

Othel1oDefs USING [ 

AbortingCommand, CommandProcessor, Confirm. GetNama, 

IndexTooLarge, MyNamels, RegisterCommandProc], 

Special Booting USING [BootFromEthernet], 

String USING [CopyToNewString]. 

System USING [ 

broadcastHostNumber, defaultSwitches. 

NetworkAddress. nu MNetworkNumber, Switches], 

Unformat USING [Error, HostNumber]; 

EtherBooter: PROGRAM 

IMPORTS Heap, OthelloDefs, SpecialBooting, String. Unformat = 

8EGIN 

HostNumber: TYPE = HostNumbers.HostNumber: 

boot.Fi leNumber: LONG STRING: 

EtherBoot: PROCEDURE = 

BEGIN 

request: Boot.EthernetRequest: 

switches: System.Switches <■ System.defau l tSwitches; 

OthelloDefs.GetName["Ether Boot from boot file number: "L. ObootF i leNumber]: 
GetAddress[@request.bfn, bootFileNumber ! 

Unformat.Error -> OthelloDefs.AbortingCommand["Can’t parse that one (No CH)"L]]; 

OthelloDefs.Confirm[]; 
request .address *■ [ 

net: System.nulINetworkNumber. 
host: System.broadcastHostNumber, 
socket: NSConstants.bootServerSocket]: 

SpecialBoot i ng.BootFromEthernet[ 

ethernetRequest: request. deviceOrdinal: 0, switches: switches]: 

END; 

GetAddress: PROCEDURE [host: POINTER TO Boot.EthernetBootFileNumber. s: LONG STRING] = 
BEGIN 

hostt *• [LOOPHOL£[Unformat .HostNumber[s , octal]]]; 

END; 

Commands: PROCEDURE [index: CARDINAL] = 

BEGIN 

SELECT index FROM 
0 => 

BEGIN 

Othel1oDefs.MyNamels[ 
myNamels: "Ether Boot"L, 

myHelpIs: "Load another program over the Ethernet"L]: 

EtherBoot[]; 

END: 

ENDCASE = > OthelloDefs.IndexTooLarge; 

END; 

commandProcessor: OthelloDefs .CommandProcessor *■ [Commands]; 

bootFileNumber *• String .CopyToNewString["26200001000" , Heap . systemZone]; -- Setup Defaul t 

OthelloDefs.Reg1sterCommandProc[@commandProcessor]; 

END. 
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-- File: OthelloDefs.mesa - last edit: 

-- Riggle.PA 12-Jan-87 16:06:45 

-- OthelloDefs.mesa (last edited by: RXJ 19-Apr-83 10:54:58) 

-- Copyright (C) 1987 by Xerox Corporation. All rights reserved. 

DIRECTORY 

Device USING [Type], 

Environment USING [bytesPerWord, wordsPerPage], 

PhysicalVolume USING [Handle, ID], 

System USING [GreenwichMeanfime], 

Volume USING [ID, Type]; 

OthelloDefs: DEFINITIONS = 

8EGIN 

CommandProcessor: TYPE = RECORD [ 

proc: PROC [index: CARDINAL], next: LONG POINTER TO CommandProcessor «- NULL]; 
MyNamels: SIGNAL [myNamels: LONG STRING, myHelpIs: LONG STRING]: 

-- resuming executes command 

Abort i ngCommand: ERROR [reason: LONG STRING, reasonOne: LONG STRING *- NIL]; 
IndexTooLarge: ERROR: 

Question: SIGNAL; 

RegisterCommandProc: PROC [commandProc: LONG POINTER TO CommandProcessor]; 

ConfirmType: TYPE = {once, twice, thrice}; 

EchoNoEcho: TYPE - {echo, stars}; 

-- Utility lo 

Confirm: PROC [how: ConfirmType *■ once]; 

DebugAsk: PROC: 

GetName: PROC [ 

prompt: LONG STRING, dest: LONG POINTER TO LONG STRING, 
how: EchoNoEcho «- echo, signalQuestion: BOOLEAN «- FALSE]; 

ReadNumber: PROC [ 

prompt: LONG STRING, min, max: LONG CARDINAL, 

default: LONG CARDINAL <- LAST[LONG CARDINAL]] 

RETURNS [ans: LONG CARDINAL]; 

ReadShortNumber: PROC [ 

prompt: LONG STRING, min. max, default: LONG CARDINAL] 

RETURNS [CARDINAL]; 

WriteFixedWidthNumber: PROC [ 

x: LONG CARDINAL, count: CARDINAL, base: CARDINAL <• 10]; 

WriteLongNumber; PROC [num: LONG CARDINAL]; 

WriteOctal: PROC [CARDINAL]; 

Yes: PROC [LONG STRING] RETURNS [BOOLEAN]; 

-- Basic 10 

Cursor: TYPE - {pointer, ftp}; 

SetCursor: PROC [Cursor]; 

FIipCursor: PROC; 

SetCommandString 
B1inkDisplay: 

CheckUserAbort: 

NewLine: 

ReadChar: 

WriteChar: 

WriteLine: 

WriteString: 

PackedTimeFromString: PROC [s: LONG STRING, justDate: BOOLEAN] 

RETURNS [System.GreenwichMeanTime]; 
string format must be: 

IF justDate=FALSE THEN bDD-MMM-YYbbHH:MM:SSbbZZTb 
IF justDate=TRUE THEN bDD-MMM-YYb 
return System.gmtEpoch for bogus time 

-- Exported by VolumelnitlmplA 
Getl.vIDFromUser: PROC [ 

prompt: LONG STRING <- NIL, calledFromSetDebuggerPtrs: BOOLEAN *■ FALSE] 
RETURNS [ 

pvID: PhysicalVolume.ID, IvID: Volume.ID, 
drive: PhysicalVolume.Handle]; 

Getl.vTypeFroniUser: PROC [prompt: LONG STRING. defaultType: Volume.Type] 

RETURNS [t: Volume.Type]; 

GetDriveFromUser: PROC RETURNS [h: PhysicalVolume.Handle]; 

GetDriveNumber: PROC [h: PhysicalVolume.Handle] RETURNS [CARDINAL]; 

GetOriveType: PROC [h: PhysicalVolume.Handle] RETURNS [Device.Type]; 

-- Get bits interface for Initial ucode fetch 
FetchlnitialMicrocode: PROC [ 

InstallProc: PROC [getPage: PROC RETURNS [LONG POINTER]]]; 

-- Clean up any outstanding ftp/stp/?? like connections 
CloseFetch: PROC; 

-- leader pages on boot files 
leaderPages: CARDINAL = 1; 

lpVersion: CARDINAL = 04193; 

1pNoteOffset: PRIVATE CARDINAL = 2; 

1 pNoteLength: CARDINAL ■= 

(Environment.wordsPerPage-1pNoteOffset)*Environment.bytesPerWord; 


PROC [LONG STRING]; -- string will be freed to Storage. 
PROC; 

PROC; -- clients should prepare UNWIND in case of abort. 
PROC; 

PROC RETURNS [CHARACTER]; 

PROC [CHARACTER]; 

PROC [LONG STRING]; 

PROC [LONG STRING]; 
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LeaderPage: TYPE = MACHINE DEPENDENT RECORD [ 
verslon(O): CARDINAL <- IpVerslon, 

1 ength(1); CARDINAL, -- count of characters in note 

note(IpNoteOffset): PACKED ARRAY [0..IpNoteLength) OF CHARACTER]: 

-- test for special commands enabled 
Wizard: PROC RETURNS [BOOLEAN]; 

-- Crock to make >@[foo]baz work 
AlternateGetCMFIle: PROC [LONG STRING]; 

-- aids for othello varients implementing canned scripts (prometheus) 
GetCannedScript: PROC; 

SuppreSsOutput: PROC RETURNS [BOOLEAN]; 

TherelsAnError: PROC; 

END. . . . 
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File: QthelloFetch.mesa - last edit: 

Higgle . PA 12-Jan-87 16:10:06 

-- OthelloFetch.mesa 

— RXJ 22-feb-84 16:46:26 

— Copyright (C) 1987 by Xerox Corporation. All rights reserved. 

DIRECTORY 

File USING [File], 

Stream USING [Handle]: 

OthelloFetch: DEFINITIONS = 

BEGIN 

Destination: TYPE - RECORD [ 

SELECT type: * FROM 

pilotFileSystemWrite => [localFile: File.File], 
string => [stringProc: PROC [LONG STRING]], 

rawWrite => [linkProc: PROC [getPage: PROC RETURNS [LONG POINTER]]]. 
ENDCASE]; 

Object: TYPE = RECORD [ 
next: Handle *■ NIL, 

Retrieve: PROC [fileName: LONG STRING, destination: Destination], 
Dolndirect: PROC [cmFile: LONG STRING] RETURNS [mine: BOOLEAN], 

List: PROC [pattern: LONG STRING], 

Close: PROC]; 

Handle: TYPE = LONG POINTER TO Object; 

Register: PROC [h: Handle]; 

Select: PROC [h: Handle]; -- makes h current; closes previous 
SetLeaderPage: PUBLIC PROCEDURE [file: File.File, note: LONG STRING]; 
StartFeedback: SIGNAL: 

GrabBitsFromStream: PROC [rs: Stream.Handle, rsSizePages: LONG CARDINAL, 
destination: Destination, note: LONG STRING *• NIL]; 

userName, userPassword; LONG STRING; 

directory: LONG STRING: 

END. 
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-- File: OthelloFetchlmpl.mesa - last edit: 

-- NFS 3-Jul-86 15:02:29 

-- bjd 22-Jun-85 12:17:33 

-- rkj 26~Feb-84 15:24:23 

-- Copyright (C) 1986 by Xerox Corporation. All rights reserved. 

DIRECTORY 
Environment, 

File USING [ 

Create. Delete, File, MakePermanent, nullFile, PageNumber. SetSize. Unknown], 
FileTypes USING [tUntypedFi1e], 

Heap USING [systemZone], 

Ml-'ile, 

MStream, 

NSName, 

NSString, 

OthelloDefs USING [ 

AbortingCommand. CommandProcessor, Confirm, FlipCursor. 

GetLvIDFromUser, GetName. 

IndexTooLarge, LeaderPage, leaderPages, IpNoteLength, lpVersion, 

MyNamels, Question, ReglsterCommandProc, WriteLine, WriteString, Yes], 
OthelloFetch USING [Destination, Handle, Object, StartFeedback], 

OthelloOps USING [ 

BootFileType, GetVolumeBootFile, MakeBootable, MakeUnbootable, 
SetPhysicalVolumeBootFile, SetVolumeBootFile], 

OthelloToolDefs USING [CloseVolume], 

Process , 

Profile , 

Space, 

SpecialFile USING [MakeTemporary], 

Stream, 

String , 

TomporaryBooting USING [InvaIidParameters], 

T i me, 

Volume USING [ID, InsufficientSpace. Open, systemID]; 

OthelloFetchlmpl: MONITOR 
IMPORTS 

File, Heap, MFile, MStream, NSString, OthelloDefs, OthelloFetch, 

OthelloOps, OtheHoToolOefs, 

Process, Profile, Space, SpecialFile, Stream, String, 

TemporaryBooting, Time, Volume 
EXPORTS OthelloDefs, OthelloFetch - 
BEGIN 

Object: TYPE = OthelloFetch.Object; 

Handle: TYPE = OthelloFetch.Handle; 

list: Handle «- NIL: 

current: Handle «■ NIL; 

cmFile: LONG STRING «- NIL; 
f ileName : LONG STRING «• NIL; 

z: UNCOUNTED ZONE = Heap.systemZone: 

S: PROC [s: LONG STRING] RETURNS [NSString.String] = INLINE [ 

RETURN[NSString.StringFromMesaString[s]]}; 

- Fetcher registration 

Register: PUBLIC PROC [h: Handle] = 

BEGIN 

h .next «- list; 

1 ist«- h; 

END: 

Select: PUBLIC PROC [h: Handle] = 

BEGIN 

IF current ff NIL THEN current.Closed: 
current*- h; 

END; 


String/Credentials Commands 


C'l earinghouseCmd: PROC = { 

domain, organization: Prof i 1 e . String «- NIL; 

CopyDomain: PROCEDURE[s: LONG STRING] = { 
domain <- Stri ng ,CopyToNewString[s , z];}; 
CopyOrganization: PROCEDURE[s: LONG STRING] = { 
organization *■ String ,CopyToNewString[s, z];}; 
{ENABLE UNWIND => { 

IF domain ft NIL THEN z. FREE[@domain]; 

IF organization ft NIL THEN z . FREE[@organization ]; } ; 
OthelloDefs,MyNameIs[ 

myNamels: "Clearinghouse"L, 
myHelpIs: "Set defaults for Clearinghouse"L]; 
Profile.GetDefaultDomain[CopyDomain]; 

Profile.GetDefaultOrganization[CopyOrganization]: 

OthelloDefs,GetName["Domain; "L, ©domain]; 

OthelloDefs.GetName["Organization: "L, ©organization]; 
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Prof He. SetDefau 1 tDomai n [domain] ; 

Profile.SetDefaultOrganization[organization]; 

}: 

z.FRE£[@domain]; z.FREE[@organization]; 


LoginCmd: PROC - { 

userName. userPassword : Prof ile .String *■ NIL; 
CopyNameAndPassword: PROC£DUR£[name, password: LONG STRING] = { 
userName <- String.CopyToNewString[name, z]; 
userPassword «• String .CopyToNewString[password , z];}; 

{ENABLE UNWIND => { 

IF userName # NIL THEN z.FREE[@userName]; 

IF userPassword # NIL THEN z.FREE[@userPassword];}; 

OthelloDefs.MyNameIs[ 

myNamels: "Login"L, myHelpIs: "Set user name & password”L]; 
Profile.GetUser[CopyNameAndPassword, none]; 

OthelloDefs.GetNanie["User: "L. QuserName]; 

OthelloDefs.GetName["Password: ”L, ©userPassword, stars]; 
Profile.SetUserfuserName, userPassword]; 

}; 

z.FREE[©userName]; z.FREE[0userPassword]; 


directory: PUBLIC LONG STRING «■ NIL: 

Directory: PROC = { 

OthelloDefs.MyNameIs[ 
myNamels: "Directory"L, 
myHelpIs: "Set Default FTP directory"L]; 
OthelloDefs.GetName["Directory: "L, ©directory]}; 


-- Simple Fetches 
FetchBoot: PROC = { 


Fetch[pilot, "Boot 

file 

name: 

"L, 

"Fetch Boot File"L, "Fetch Boot File"L, "boot"L, TRUE]} 

FetchGerm: PROC = { 





Fetch[germ, "Germ 

file 

name: 

"L, 

"Germ Fetch"L, "Fetch Germ"L, "germ"L]}; 

Fetc.hPi lotMicrocode: 

PROC 

= { 



Fetch[ 





softMicrocode. 





"Pilot microcode 

file 

name: 

"L, 


"Pilot Microcode 

Fetch"L. 




"Fetch and Install Pilot Microcode"L, 
"db"L]}: 

FetchDiagnosticMicrocode: PROC = { 

Fetch[ 

hardMicrocode, 

"Diagnostic microcode file name: "L, 
"Diagnostic Microcode Fetch"L, 

"Fetch and Install Diagnostic Microcode”L, 
"db"L]}; 


Fetch: PROC [ 

type: Othel1oOps.BootFileType. prompt, name, helpMsg, extension: STRING, 

bootFile: BOOLEAN «- FALSE] = { 

created: BOOLEAN: 

file: File.File: 

firstPage: File.PageNumber; 

lvID: Volume.ID; 

local: BOOLEAN current = NIL: -- if no connection open, assume local file. 
OthelloDefs.MyNamels[myNameIs: name, myHelpIs: helpMsg] ; 

1 vID «- Othel loDefs .GetLvIDFromUser[ ]. lvID; 

OthelloDefs,GetName[prompt, @fileName]: 

IF lvID = Volume.systemID AND bootFile THEN { 

-- fetching boot file for system volume. 
oldFile: File.File; 

IF local THEN file *■ GetLocalFi Ie[ 1 vID. Fi le.nul lFile 
INoLocalFile => GOTO NoFetch'J 
ELSE { 

file <- File .Create[l vID. 1, F i 1 eTypes . tUntypedF i 1 e ]; 
current.Retrieve[fileName, [pilotFi1eSystemWrite[fi1e]] 

IUNWIND => File.Delete[file]; 

Volume.InsufficientSpace, Space.InsufficientSpace => { 

Othel1oDefs.WrlteLine["Insufficient space for new boot fi1e."L]; 

File.Delete[file]; 

GOTO NoFetch;}];}; 

OthelloOps.MakeUnbootable[file, type, firstPage ! 

File.Unknown => CONTINUE: 

TemporaryBooting.InvalidParameters *> CONTINUE]; 

[oldFile, firstPage] <- OthelloOps .GetVolumeBootFi 1 e[ 1 vID, type]; 
OthelloOps.MakeUnbootable[oldFile, type, firstPage ! 

File.Unknown => CONTINUE; 

TemporaryBooting.InvalidParameters => { 

OthelloDefs.WriteLinef'Warning, trouble making unbootable"L ]; 
CONTINUE}]; 

Special File.MakeTemporary[oldFi1e]; 
created «■ TRUE:} 

ELSE { -- not system volume 
Volume.Open[1vID]; 

[file. firstPage] «- Othel loOps .GetVolumeBootF i le[lvID . type]: 

IF local THEN { 

newBootFile: File.File; 
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created «- TRUE; 

newBootFile *■ GetLocalFile[lvID. file !NoLocalFile -> GOTO NoFetch]; 
file «- newBootFile;} 

ELSE { 

IF (created *• file = File.nul lFile) THEN 

file «- File.Create[lvID, 1, Fi leTypes . tUntypedFi 1 e] 

ELSE Othel1oOps,MakeUnbootable[fi1e, type, firstPage ! 

File.Unknown => CONTINUE; 

TemporaryBooting.InvalidParameters => { 

Othel loOefs .WriteLine["Warn1ng, trouble making unbootable'’L] ; 
CONTINUE}]; 

current.Retrieve[fileName, [p ilotFi leSystemWrite[file]] 

! UNWIND => { 

IF created THEN File.Delete[file];OthelloToolDefs.CloseVolume[lvID]}]; 

}: 

OthelloDefs.WriteString["Instal1ing..."L]; 

Othelloops.SetVolumeBootFile[file, type , OthelloDef s.leaderPages]; 

IF.created THEN File.MakePermanent[file]; 

OthelloOps.MakeBootable[file. type. OthelloDefs.leaderPages 
! TemporaryBooting.InvalidParameters => { 

OthelloDefs.WriteLine["Warn1ng, trouble making bootable’L]; CONTINUE}]; 

OthelloOefs.WriteLine["done"L]; 

IF type IN [hardMicrocode..germ] AND 

OthelloDefs.Yes["Shal1 I also use this for the Physical Volume? "L 
! UNWIND --> Othel loToolDefs.CloseVolume[l vID]] THEN 
Othelloops.SetPhysicalVolumeBootFi1e[file, type, Othel1oDefs.leaderPages]; 
OthelloToolDefs.CloseVolume[lvID]; 

EXITS NoFetch => NULL: 


NoLocalFile; ERROR = CODE; 

GetLocalFile: PROCEDURE [ 

IvID: Volume.ID. oldFile: File.File] RETURNS [file: File.File] = { 
fi leName already has name of local file. 
mStream: MStream.Handle: 
filePages: LONG CARDINAL; 
note: LONG STRING; 

mStream «■ MStream.ReadOnly[f ileName . [] ! 

MStream.Error => { 

OthelloDefs.WriteLine["Unable to acquire local f11e"L]; 

ERROR NoLocaiFile:}]; 

IF oldFile # File.nullFile THEN File.Delete[oldFi1e]; 

filePages «- (MStream.GetLength[mStream] + Environment.bytesPerPage I) / 

Environment.bytesPerPage; 
file *■ File.Create[ 

volume: IvID, initialSize: filePages + OthelloDefs.1eaderPages , 
type: FileTypes.tUntypedFile ! 

Volume . Insuff icientSpace => Othel loDefs .AbortingComniand['’Volume Full"L]]; 
note «• MakeNote[MStream.GetF11e[mStream]]; 

GrabB1tsFromStream[ 

mStream, filePages, [pilotFileSystemWrite[file]], note! 

OthelloFetch.StartFeedback => { 

OthelloDefs.WriteString["Copying local file..."L]; 

RESUME}]; 

OthelloDefs.WriteLine["done"L]; 

Stream.Delete[mStreamJ; 
z.FREE[@note]; 


bufPages; CARDINAL = 8: 

StartFeedback: PUBLIC SIGNAL = CODE; 

MakeNote: PROCEDURE[file: MFile.Handle] RETURNS[note : LONG STRING] = { 
time: LONG STRING <- [20]: 

note *• z .NEW[Stri ngBody[MF i le .maxNameLength]] ; 
note.length ^ 0; 

MFile.GetFullName[file, note]; 

String . AppendStringAndGrow[@note , " ("L., z]; 

Time.Append[time. Time.Unpack[MFile.GetCreateDate[fi1e]]]; 

String.AppendStringAndGrow[@note, time, z]; 

String.AppendCharAndGrow[@note, '), z]; 


GrabBitsFromStream: PUBLIC PROC [ 

rs: Stream.Handle, rsSizePages: LONG CARDINAL. 

destination: Othel 1 oFetch. Desti nation, note: LONG STRING «- NIL] = [ 

WITH destination SELECT FROM 
pilotFileSystemWrite => { 
buffer: LONG POINTER ^ NIL; 
base: File. PageNumber «■ 0; 
got: CARDINAL: 

File.SetSize[localFile, rsSizePages + OthelloDefs.1eaderPages 
! Volume.InsufficientSpace => OthelloDefs.AbortingCommand["Volume Full"L]]; 
SetLeaderPage[localF11e, note]: 

SIGNAL StartFeedback; 

WHILE base < rsSizePages DO 

thisPages: CARDINAL = CARDINAL[MIN[rsSizePages-base, bufPages]]; 

size: CARDINAL = thisPages*Environment.bytesPerPage; 

start: CARDINAL <- 0; 

nProcesses «- 0; 
buffer Space.Map[ 

window:[localFile, base^-Othel 1 oDefs . leaderPages , thisPages], 
life: dead].pointer; 

DO 
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[bytesTransferred: got] «■ rs ,GetBlock[[ 

blockPointer: buffer, startlndex: start, stopIndexPlusOne: size] ! 
Stream,EndOfStream a > { 

got *■ 0; start *■ start + nextlndex; CONTINUE}; 

UNWIND => [] «- Space .Unmap[buffer]]; 

IF got = 0 THEN {[] «■ Space .Unmap[buffer]; RETURN}; 

IF (start start + got) - size THEN EXIT; 

ENDLOOP; 

ForkUnmap[buffer]; 

Othel1oDefs.FIipCursor[]; 
base <- base + thisPages; 

ENDLOOP; 

buffer *■ Space,ScratchMap[ 1]; -- check for any leftover stuff 
[bytesTransferred: got] «- rs.GetBlock[[ 
blockPointer: buffer, startlndex: 0, 
stopIndexPlusOne: Environment.bytesPerPage] ! 

Stream.EndOfStream => {got «- nextlndex; CONTINUE}; 

UNWIND = > [] 4 - Space .Unmap[buffer] ]; 

[] «- Space ,Unmap[buf fer] ; 

IF got # 0 THEN OthelloOefs.AbortingCommand[ 

"File longer than advertised length"L]}; 
string => { 

SIGNAL Startfeedback; 

DO 

stringOverhead; CARDINAL = SIZE[StringBody]*Environment.bytesPerWord; 
string: LONG STRING = Space.ScratchMap[bufPages]; 
stringt «- [ 
length: 0, 

maxlength; bufPages*Environment.bytesPerPage - stringOverhead, 
text: ]; 

WHILE strinq,Ienqth < strinq.maxlenqth DO 
got: CARDINAL; 

[bytesTransferred: got] 4- rs.get[ 
rs, 

[blockPointer: LOOPHOLE[Ostring.text], 
startlndex: string.1ength, stopIndexPlusOne; string.maxlength], 
rs.options 

! Stream.EndOfStream => { 

got «- 0; string. length 4- string. length *■ nextlndex; CONTINUE}: 
UNWIND => [] <- Space .Unmap[stri ng]] ; 

IF got = 0 THEN { 

stringProc[string! UNWIND -> [] *• Space ,Unmap[string]] ; 

[] ♦- Space .Unmap[string] ; RETURN}; 
string. length <- string . length + got; 

ENDLOOP; 

[] 4- Space.Unmap[string] ; 

OthelloOefs.AbortingCommand["Command file too long!"L]; 

ENDLOOP}; 
rawWrite ->{ 

buffer: LONG POINTER = Space.ScratchMap[1]; 
done: BOOLEAN - FALSE; 
first: BOOLEAN «■ TRUE; 

options: Stream. InputOptions <- rs.options: 

GetPage: PROC RETURNS [LONG POINTER] = { 
got: CARDINAL; index: CARDINAL <- 0; 

IF first THEN {SIGNAL StartFeedback; first FALSE}: 

WHILE -done DO 

[bytesTransferred: got] «- rs.get[ 
sH: rs, 

block: [blockPointer: buffer, startlndex: index, 
stopIndexPlusOne: Environment.bytesPerPage], 
options: options 

! Stream. EndOfStream => {got 4- nextlndex; done 4- TRUE: CONTINUE}]; 

IF (index *■ index + got) = Environment .bytesPerPage 
OR done THEN {OthelloDefs,F1ipCursor[]; EXIT} 

ENDLOOP; 

RETURN[IF done AND index = 0 THEN NIL ELSE buffer]}: 
options . signal EndOfStream 4- TRUE; 

1 inkProc[GetPage ! UNWIND => [] *- Space ,Unmap[buffer]] ; 

WHILE -done DO [] «* GetPage[ ! UNWIND => [] 4- Space.Unmap[buffer]] ENDLOOP: 
[] 4- Space ,Unmap[buffer]} ; 

ENDCASE => ERROR}; 

-- Initial Ucode Fetch Command 

FetchlnitialMicrocode: PUBLIC PROC [ 

Insta11Proc: PROC [getPage: PROC RETURNS [LONG POINTER]]] - { 

CheckOpen[]; 

Othel loDef s .GetName["Fi.le name: "L, OflleName]; 

OthelloDef s.Confirm[]; 

current.Retrieve[fileName, [rawWrite[InstalIProc]]]}; 

-- Command Files 

AlternateGetCMFile: PUBLIC PROC [s; LONG STRING] = { 
z.FREE[@cmFi1e]; 

cmFile 4- z ,NEW[StringBody[s . length+8]] : 

FOR i: CARDINAL IN [1. .$.length) DO 

String.AppendChar[cmFi1e, $[1]] ENDLOOP; 

Dolndirect[]}: 

Indirect: PROC = { 

OthelloOef s,MyNameIs[ 

myNamels; myHelpIs: "Run command file”L]; 

Othel1oDefs,GetName["Command file: "L, QcmFIle 
! OthelloDefs.Question => { 

OthelloDefs.WriteLine["[Host]<Dir>Fi1ename"L]; RESUME}]; 
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Dolndirect[]}; 


Oolndirect: PROC = ( 

[] «- String.AppendExtensionIfNeeded[@cmFile, "Othello"!., z]: 

FOR h: Handle «- list, h.next UNTIL h = NIL 00 
IF h,DoIndirect[cmFi1e] THEN RETURN; 

ENOLOOP; 

OthelloDefs.AbortingCommand["Unrecognizable command file name"Lj}; 


-- Misc. commands 

nProcesses, maxProcesses: NATURAL «• LAST[NATURAL]; 
finished: CONOITION; 

ForkUnmap: ENTRY PROCEDURE [buffer: LONG POINTER] - 
BEGIN 

BEGIN ENABLE Process.TooManyProcesses = > [maxProcesses «- nProcesses; RETRY); 

WHILE nProcesses >= maxProcesses DO 
WAIT finished; ENDLOOP; 

Process,Detach[LOOPHOLE[FORK DoUnmap[buffer]]] ; 
nProcesses «- nProcesses+1; 

END; 

END; 

OoUnmap: ENTRY PROCEDURE [buffer; LONG POINTER] = 

--buffer *■ Space.Unmap[buffer, return]; 

BEGIN 

buffer «• Space.Unmap[buffer]; 
nProcesses «- MAX[nProcesses-l, 0]; 

NOTIFY finished; 

END; 

CloseCmd: PROC = f 
OthelloDefs.MyNamets[ 

myNamels: ''Close"L, myHelpIs: "Close currently open connection"L]; 

CloseFetch[]); 

C loseFetch: PUBLIC PROC -- { 

Select[NIL]}; 

ListCmd: PROC = { 

OthelloDefs.MyNameIs[ 

myNamels: "List Files"L, myHelpIs: "Enumerate files matching pattern"L]; 

CheckOpen[]; 

OthelloDefs.GetName["Pattern: "L, GfileName 
! OthelloDefs.Question -> { 

Othe1loDefs,WriteLine["pattern to match"L]; RESUME}]; 
current.List[fileName]}; 

CheckOpen: PROC = { 

IF current = NIL THEN 

Othel1oDefs.AbortingCommand["You must execute an Open command first"L]}; 

SetLeaderPage: PUBLIC PROCEDURE [file: File. File, note: LONG STRING] = 

BEGIN 

Ip: LONG POINTER TO Othel 1 oDefs . LeaderPage «- Space .Map[[file . 0. Othe I loDef s . leaderPages] ] .pointer 
Ip.version Othel1oDefs.1pVersion; 

Ip. length «■ MlN[note. length, Othel loDefs. IpNoteLength]; 

FOR i: CARDINAL IN [0..1p. Iength) DO 
lp.note[i] *■ note[i]: 

ENDLOOP: 

[] Space .Unmap[lp]; 

END: 


-- command processor 

commandProcessor: OthelloDefs .CommandProcessor «- [FetchCommands]; 

FetchCommands: PROC [index: CARDINAL] = { 

SELECT index FROM 
0 => Indirect[]; 

1 => ClearinghouseCmd[]; 

2 => CloseCmd[]; 

3 => Directory[]; 

4 => FetchBoot[]; 

5 => FetchDiagnostlcMicrocode[]; 

6 => FetchGerm[]; 

7 => FetchPilotMicrocode[]; 

8 => ListCmd[]; 

9 => LoginCmd[]; 

ENDCASE => OthelloDefs.IndexTooLarge) ; 

- - in it 

OthelloDefs.RegisterCommandProc[@commandProcessor]: 

END. 

Log 

Ei-Jun-86 12:25:59 NFS Adapted for OthelloTool 
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-- Copyright (C) 1984 by Xerox Corporation. All rights reserved. 

-- OthelloFloppy.mesa 

LXR 10-Feb-84 16:25:51 

RXJ 27-Feb-84 17:17:08 

DIRECTORY 

AccessFloppy USING [ 

Attributes, AttributesRecord, Close. Error, ErrorType, GetAttributes, 
leaderLength. Lookup, maxDataSize, Open, tFloppyLeaderPage, Time], 

Ascii USING [CR, SP], 

Environment USING [bytesPerPage. bytesPerWord], 

Heap USING [systemZone], 

File USING [File, nullFile, PageNumber, SetSIze], 

Floppy USING [ 

Error, ErrorType, FileHandle, GetFi1eAttributes, GetNextFile, nulirilelD, 
nul1VolumeHandle, PageNumber, Read, VolumeHandle], 

Format USING [Char, Date, Decimal, StringProc], 

NSFile USING [String], 

OthelloDefs USING [ 

AbortingCommand, CheckUserAbort, CommandProcessor, FlipCursor, 

IndexTooLarge, leaderPages, MyNamels, RegisterCommandProc, 

SetCommandString, SetCursor. WriteLine. WriteString], 

OthelloFetch USING [Destination, Object, Register, Select, SetLeaderPage], 

Process USING [Detach], 

Space USING [Map, ScratchMap, Unmap], 

String USING [ 

AppendCharAndGrow, AppendLongDecimal, AppendStringAndGrow, 

CopyToNewString, Length, Lowercase], 

Time USING [Append, Unpack], 

Volume USING [ID, TnsufficientSpace] ; 

OthelloFloppy: PROGRAM 
IMPORTS 

AccessFloppy, File, Floppy. Format, Heap, OthelloDefs. OthelloFetch, 

Process, Space, String. Time. Volume = 

BEGIN 

Dolndlrect: PROC [cmFile: LONG STRING] RETURNS [mine: BOOLEAN] = 

BEGIN 

s: LONG STRING * NIL; 

GetString: PROC [c: LONG STRING] = {$ «- String .CopyToNewString[c, Heap. systemZone]}: 
IF cmFile[0] - '[ THEN RETURN [FALSE]; 

OthelloFetch.Select[@fetcher]; OpenFloppy[]: 

Retrieve[cmFile, [string[GetString]] 

! UNWIND => Heap,systemZone.FREE[@sj]: 

OthelloDefs.WriteLine["done"L]; 

OthelloDefs.SetCommandString[s]; 

RETURN[TRUE] 

END; 


- MISC Stuff/Commands 

floppy: Floppy .VolumeHandle «- Floppy. nul I VolumeHandle ; 

FloppyOpen: PROC RETURNS [BOOLEAN] = INLINE (RETURN[f loppy ft Floppy. nul lVolumeHandle]} ; 

OpenCmd: PROC = { 

OthelloDefs .MyNameIs[myNameIs: "Floppy Open"l., myHelpIs: "Prepare to read files from floppy"L] 
OthelloFetch.Select[@fetcher]; 

OpenFloppy[]}; 

OpenFloppy: PROC = [ 

floppy *■ AccessFloppy.Open[ 

! AccessFloppy.Error => OthelloDefs.AbortingCommand["Can't open floppy"L]; 

Floppy.Error => (FIoppyError[error]; RETRY}]}: 

CloseFloppy: PROC = ( 

AccessFloppy.Close[ 

! AccessFloppy.Error, Floppy.Error => CONTINUE]; 
floppy *• Floppy. nul lVolumeHandle} ; 

FloppyList: PROC [pattern: LONG STRING] = { 

ListFiles[IF String,Length[pattern] = 0 THEN NIL ELSE pattern]}; 


-- Central commands 

commandProcessor: OthelloDefs .CommandProcessor «■ [FloppyCommands] ; 

F1oppyCommands: PROC [index: CARDINAL] - { 

SELECT index FROM 
0 => OpenCmd[]; 

ENDCASE => OthelloDefs.IndexTooLarge}; 

fetcher: OthelloFetch.Object <- [ 

Retrieve: Retrieve, 

Dolndirect: Dolndirect, 

List: FloppyList, 

Close: CloseFloppy]; 


-- file retrieval Stuff/Commands 


EnumProc: TYPE = PROCEDURE [ 
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attributes: AccessFloppy.Attributes, fH: Floppy.FileHandle, name: LONG STRING] 

RETURNS [stop: BOOLEAN <- FALSE]; 

ListFlles: PROCEDURE [pattern: LONG STRING] * 

BEGIN 

Write: Format,StringProc = [OthelloDefs.WriteString[s]}; 

ListOne: EnumProc = 

BEGIN 

Write[name]; 

FOR i: CARDINAL IN [name.length + WritePartial[Write, attributes ]..40) DO 
Format.Char[Write, Ascii.SP]; ENDLOOP; 

Format.Date[Write. attributes.createDate. full]; 

Format.Char[Write, Ascii.CR]; 

END: 

EnumerateFloppyFiles[ListOne, pattern ]; 

END; 

WritePartial: PROCEDURE [Write: Format.StringProc, attributes: AccessFIoppy.Attributes] 
RETURNS [chars: CARDINAL «- 0] = 

BEGIN 

CountedNumber: PROCEDURE [n: LONG CARDINAL] RETURNS [CARDINAL] = ( 
s: STRING = [12]; 

String.AppendLongDecimal[$. n]; 

Write[s]; 

RETURN[$.length]}; 

IF attributes.offset # 0 OR attributes.size # attributes.totalSize THEN [ 
chars *■ 4; 

Format.Char[Wr1te. '[]; 

chars <- chars *- CountedNumber[attributes .offset]: 

Write[",."L]; 

chars <- chars +■ CountedNumber[attributes .of fset+attributes . size-l] ; 

Format.Char[Write, ’]]}; 

END; 

EnumerateFloppyFi1es: PROCEDURE [ 
proc: EnumProc. pattern: LONG STRING *■ NIL] = 

BEGIN 

nullFile: Floppy .FileHandle «- [volume: floppy, file: Floppy. nul 1 Fi lelD] ; 
attributes: AccessFl oppy .Attributes *■ Heap. systemZone. NEW[ 

AccessFIoppy.AttributesRecord[AccessFloppy.maxDataSize]]; 
name: LONG STRING = LOOPHOLE[@attributes.length] ; 

BEGIN ENABLE Floppy.Error => { 

FloppyError[error] ; nul 1 Fi le . volume «• floppy; RETRY); 

FOR current: Floppy. FileHandle *• 

Floppy.GetNextFile[nullFile].nextFile, 

Floppy.GetNextFile[current].nextFile 
WHILE currenttfnu11Fi1e 00 

ENABLE UNWIND => Heap.systemZone.FREE[@attributes]; 

OthelloDefs.CheckUserAbort[]; 

IF Floppy.GetFi1eAttributes[current].type # AccessFIoppy.tFloppyLeaderPage THEN LOOP; 
AccessF1oppy.GetAttributes[current, attributes]; 

IF (pattern = NIL OR MaskFi1ename[file: name, mask: pattern]) 

AND proc[attributes. current, name] THEN EXIT; 

ENDLOOP; 

END; -- ENABLE 

Heap.systemZone.FREE[@attributes]; 

END; 

MaskFilename: PROCEDURE [ 

file: LONG STRING, filelndex: CAROINAL «■ 0. mask: LONG STRING, 
masklndex: CARDINAL «■ 0] 

RETURNS [BOOLEAN] = 

BEGIN 

-- local variables 
1. j: CARDINAL; 
vrildString: CHARACTER = 
wildChar: CHARACTER = '0; 

process each character in mask 
FOR i IN [masklndex..mask.length) DO 
SELECT mask[i] FROM 

wildString => -- matches any string of zero or more characters 

BEGIN 

FOR j IN [f1lelndex..fi1e.length] DO 

IF MaskFilename[file, j. mask, 1 + 1] THEN 
RETURN[TRUE]; 

ENDLOOP; 

RETURN[FALSE]; 

END; 

wildChar => -- matches any single character 

IF filelndex = file.length THEN RETURN[FALSE] 

ELSE filelndex <- filelndex + 1; 

ENDCASE => 

IF filelndex = file.length 

OR String. LowerCase[f i 1 e[f i 1 elndex]] ft String . LowerCase[mask[ i ]] THEN 
RETURN[FALSE] 

ELSE filelndex ♦- filelndex + 1; 

ENDLOOP; 

- filename passes mask if entire filename has been consumed 
RETURN[filelndex - file.length]; 

END; 

StartFeedback; SIGNAL = CODE; 

-- must fix Retrieve to deal with boot files that is in pieces 

Retrieve: PROC [fileName: LONG STRING, destination: OthelloFetch.Destination] = { 
segmentPages. total Pages, bytes, offset: LONG CARDINAL: 
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name: LONG STRING *■ NIL: 

BEGIN 

ENABLE Floppy.Error => (FloppyError[error]; RETRY}; 
fH: Floppy.Fi 1 eHandle «■ [floppy, Floppy.nullFIlelD] ; 

[fh; fH. offset: offset, segmentPages: segmentPages, totalPages: totalPages. bytes: bytes, name: name] 
GrabBits[ 

fH: fH, offset: offset, segmentPages: segmentPages, 

totalPages: totalPages, sizeBytes: bytes, destination: destination, 

note: name ! 

StartFeedback => { 

OthenoDef$,Wr1teString["Fetching. . ,"L]; 

OthelloOefs.SetCursor[ftp]; 

RESUME}; 

UNWIND => (OthelloDefs.SetCur$or[pointer]; Heap.systemZone.FREE[@name]}]; 

Heap.systemZone.FREE[§name]: 

OthelloDefs.SetCursor[pointer]; 

END}; 

GetFile: PROC [fileName: LONG STRING] RETURNS [ 

fh: Floppy.FileHandle, offset, segmentPages, totalPages, bytes: LONG CARDINAL, name: LONG STRING] = 
BEGIN 

time: LONG STRING «- [20]; 

attributes: AccessFl oppy .Attributes *- Heap. systemZone . NEW 
[AccessFloppy.AttributesRecord[AccessFloppy.maxDataSize]]; 
name «■ Heap.systemZone.NEW[StringBody[60]]; 

(ENABLE UNWIND *> 

(Heap.systemZone.FREE[@attributes]; Heap.systemZone.FREE[©name]}: 
fh *■ AccessFl oppy. LookUp[ 

MakeNSString[fileName], attributes 
! AccessFloppy.Error => 

SELECT type FROM 

fileNotFound 3 > OthelloDefs.AbortingCommand["No such file"L]: 
volumeNotOpen => ( 

CloseFloppy[]: 

OpenFloppy[]: 

RETRY}; 

ENDCASE => OthelloDefs.AbortingCommand[ "Unexpected access floppy problem"L]; 

Floppy.Error = > (FIoppyError[error]; RETRY}]; 

String.AppendStringAndGrow[ 

©name, L00PH0LE[@attributes.1ength], Heap.systemZone]; 

St:ring .AppendStringAndGrow[@name, " ("L, Heap.systemZone] : 

Time.Append[time, Time,Unpack[attr1butes.createDate]]; 

String.AppendStringAndGrow[@name, time, Heap.systemZone]; 

String.AppendCharAndGrow[@name, '), Heap.systemZone]: 

offset <- attributes . offset; 

segmentPages <- attributes. size; 

totalPages «- attributes . total Size : 

bytes «- attributes. total Si zelnBytes; 

Heap.systemZone.FREE[@attributes]}; 

END: 

MakeNSString: PROCEDURE [s: LONG STRING] RETURNS [NSFile.String] = ( 

IF s = NIL THEN RETURN[[bytes: NIL, length: 0, max length: 0]]; 

RETURN[[bytes: LOOPHOLE[@s.text], length: s. length, maxlength: s.max length]]}; 

bufPages: CARDINAL = 8; 

GrabBits: PROC [ 

fH: Floppy.FileHandle, offset, segmentPages, totalPages: LONG CARDINAL, 
sizeBytes: LONG CARDINAL, destination: Othellofetch.Destination, 
note: LONG STRING «- NIL] = ( 
base: File.PageNumber «• 0; 

WITH destination SELECT FROM 
pilotFileSystemWrite => ( 
buffer: LONG POINTER «• NIL: 

File.SetSize[localFile, totalPages ► OthelloDefs.1eaderPages 
! Volume.InsufficientSpace = > OthelloDefs,AbortingCommand["Volume FulV’L]]; 

OthelloFetch.SetLeaderPage[localFile, note]; 

SIGNAL StartFeedback: 

WHILE base < segmentPages DO 

thisPages: CARDINAL = CARDINAL[MIN[segmentPages base. bufPages]]: 
buffer *■ Space,Map[ 

window: [local Fi le, off set+base^-Othel loDef s . leader Pages . thisPages], 
life: dead].pointer: 

Floppy.Read[fH, base+AccessFloppy.leaderLength, thisPages, buffer ! 

Floppy.Error => FloppyError[error]; 

UNWIND => [] *■ Space ,Unmap[buffer]] ; 
buffer Space.Unmap[buffer, return]; 

Process ,Detach[LOOPHOLE[FORK Space .Unmap[buf fer]]]; buffer «- NIL; 

OthelloDefs .FIipCursor[]; 
base «■ base + thisPages; 

ENDLOOP}: 
string => [ 

thisPages: CARDINAL = CARDINAL[MIN[segmentPages base, bufPages]]; 
stringOverhead: CARDINAL = SIZE[StringBody]*Environment.bytesPerWord; 
string: LONG STRING <- NIL; 

IF segmentPages-base > thisPages THEN 
OthelloDefs,AbortingCommand["Command file too long!"L]; 

SIGNAL StartFeedback; 

string *- Space . ScratchMap[thi$Pages+-l] ; 

stringt t- [ 

length; CARDINAL[sizeBytes], 

maxlength: bufPages*Environment.bytesPerPage - stringOverhead. 
text: ); 

Floppy,Read[fH, base+AccessFloppy.leaderLength, thisPages, ©string.text ! 

Floppy.Error => FIoppyError[error]: 

UNWIND => [] *■ Space.Unmap[string]] ; 


GetFi1e[fileName]; 
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stringProc[string]; 

[] «• Space.Unmap[stringj} ; 
rawWrite =>{ 

buffer: LONG POINTER = Space.ScratchMap[1]; 
count: CARDINAL «- 0; 

GetPage: PROC RETURNS [LONG POINTER] = ( 

IF count = 0 THEN SIGNAL StartFeedback: 

IF count = segmentPages THEN RETURN[NIL]; 

Floppy,Read[fH, base+count+AccessFloppy.leaderLength, 1. buffer ! 
Floppy.Error => FloppyError[error]; 

UNWIND => [] *- Space.Unmap[buffer]]; 
count *• count + 1; 

OthelloDef s.FIipCursor[]; 

RETURNfbuffer]}; 

1 inkProc[GetPage ! UNWIND => [] <- Space .Unmapfbuffer]]; 

[] <- Space .Unmapfbuffer]}; 

ENDCASE -> ERROR}; 

FloppyError: PROC [error: Floppy.ErrorType] = 

BEGIN 

myProc: Format.StringProc = (Othel1oDefs.WriteString[s]}; 

SELECT error FROM 

invalidVolumeHandle => ( 

AccessFloppy,Close[! AccessFloppy.Error. Floppy.Error => CONTINUE]; 
OpenFloppy[]: RETURN}: 

notReady => Othel loDefs .AbortingComniand["Can ' t open floppy"L]; 
badDisk, badSectors. hardwareError => 

OthelloDefs.AbortingCommand["Floppy hardware problenTL]; 
invalidFormat. 1nvalIdPageNumber. needsScavenging => 

OthelloDefs.AbortingCommand["FIoppy not readable"L]; 

ENDCASE => { 

OthelloDefs.WriteString["Floppy error "L]; 

Format.Decimal[myProc. error.ORD]}; 

OthelloDefs.AbortingCommand[NIL] 

END; 


-- initialization 

Othel loDefs. Reg is terCon>mandProc[@ command Processor]; 
OthelloFetch.Register[@fetcher]; 

END. 
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File: Othel 1 oNS.mesa - last edit: 

-- BJD .PA 15-Feb-85 16:10:58 

-- AOf 25-Jan-85 10:33:26 

-- Copyright (C) 1983 , 1985 by Xerox Corporation. All rights reserved. 

DIRECTORY 

AddressTranslation USING [Error, PrintError, StringToNetworkAddress], 

Auth USING [IdentityHandle], 

NSBuffer USING [Body. Buffer. ReturnBuffer]. 

ExtendedString USING [AppendNumber], 

Format USING [StringProc], 

Inline USING [HlghByte, LowByte], 

NSConstants USING [echoerSocket], 

NSTypes USING [maxDataBytesPerEcho, wordsPerlDPHeader]. 

OthelloDefs, 

Process USING [Detach. Pause, SecondsToTicks, Yield], 

Profile USING [GetID], 

Router USING [ 

Fi1IRoutingTable, GetDelayToNet, infinity, endEnumeration, startEnumeration. 
EnumerateRoutingTable], 

Socket USING [ 

AssignNetworkAddress, Create, Delete, GetPacket, ChannelHandle. 

PutPacket, GetSendBuffer, SetPacketBytes, GetPacketBytes , 

SetWaltTlme, TimeOut], 

String USING [AppendString, StringBoundsFault], 

System USING [NetworkAddress, SocketNumber, NetworkNumber, HostNumber]; 

OthelloNS: PROGRAM 

IMPORTS AddressTranslation, NSBuffer, ExtendedString, Inline, Profile, Process. Router. 

String. Socket. OthelloDefs = 

BEGIN OPEN OthelloDefs: 

EchoUser: PROC = 

BEGIN 

bytesPerBuffer: CARDINAL; 
funny, late: LONG CARDINAL «■ 0: 

recv, sent: LONG CARDINAL «• 0; 

wrong: LONG CARDINAL *■ 0; 

me, where: System.NetworkAddress; 

mySoc: Socket.ChannelHandle; 

packetNumber: CARDINAL «• 0: 

pleaseStop: BOOLEAN «- FALSE; 

routing: CARDINAL; 

Watch: PROC - ([] «- ReadChar[]; pleaseStop «- TRUE); 

PrintErrorNS: PROC [b: NSBuffer.Buffer] = ( 
body: NSBuffer.Body «- b.ns: 
source: System . NetworkAddress <- body.source: 

NewLine[]; 

IF body.packetType = error THEN [ 
len: CARDINAL = body.pktLength; 

WriteString["[Error packet, code="L]; 

WriteOctal[LOOPHOLE[body.errorType]]; 

WrIteString[", from: "L]; 

PrintNSAddress[@source]; 

Wr1teString["] "L]; 

FOR 1: CARDINAL IN [0..1en - NSTypes.wordsPerlDPHeader) DO 
WriteChar[In1ine.LowByte[body.errorBody[i]]]; 

WriteChar[Inline.HighByte[body,errorBody[i]]j; 

ENDLOOP} 

ELSE { 

WriteString[" * * * * * "L]; 

WriteString["Funny packet type = "L]: 

WriteOctal[LOOPHOLE[body.packetType]]; 

WriteString[" ***** "L]}; 

NewLine[]}; 

identity: Auth . IdentityHandl e «- NIL: 

getID: PROC [id: Auth. IdentityHandle] = (identity <- id); 

GetName["Echo to: "L. SechoName]; 

Profile.GetID[simple. getID]; 

[where. ] *■ AddressTranslation ,StringToNetworkAddress[echoName. identity ! 
AddressTranslation.Error => { 
msg: LONG STRING * [100]; 
appendErrorMsg; Format.StringProc - ( 

String.AppendStr1ng[msg, s ! String.StringBoundsFault => RESUME[NIL]]}: 
AddressTranslation.PrintError[error: errorRecord, proc: appendErrorMsg]; 
OthelloDefs.AbortingCommand[msg]}]; 
where.socket «■ NSConstants .echoerSocket; 
routing «* Router .GetDelayToNet[where. net]; 

IF routing = Router.infinity THEN 
AbortingCommand["Can*t reach that network"L]; 

me Socket.AssignNetworkAddress[]; 
mySoc *■ Socket .Create[me . socket] : 

Socket.SetWaitTime[mySoc. 2000]; --two second timeout 

Wri teStr1ng[". ["L] ; PrintNSAddress[®nie] ; Wri teString["] => ["L]; 

PrintNSAddress[@where]: 

WriteChar[’]]; NewLine[]; 

Process.Detach[FORK watch[]]: 
bytesPerBuffer *- NSTypes .maxDataBytesPerEcho : 

UNTIL pleaseStop DO 

FOR len: CARDINAL IN [4..bytesPerBuffer] UNTIL pleaseStop DO 
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b: NSBuffer.Buffer <- Socket .GetSendBuffer[mySoc]; 
body: NSBuffer.Body *■ b.ns; 
body .destination <- where; 

body.packetType «- echo; body.echoType «- echoRequest; 

Socket.SetPacketBytes[b, Ten]; 

FOR i: CARDINAL IN [4..Ten - 4) DO body.echoBytesfi] «• i: ENDLOOP; 

body,echoWords[0] «- body.echoWords[ 1] <- (packetNumber *- packetNumber + 1); 

Socket.PutPacket[mySoc, b]; sent «■ sent + 1: 

Process.Yield[]; -- be sure we don’t hog machine 

BEGIN 

b Socket,GetPacket[inySoc ! Socket.TimeOut => GOTO late]; 

SELECT TRUE FROM 

(body.packetType tt echo) => 

{funny «- funny + 1; Print£rrorNS[b]}; 

(body .echoWords[0] ft packetNumber) => {WriteChar[ '#]; late *■ late + 1}; 
(body ,echoWords[l] tt packetNumber) => (WriteChar[ '^]; late *■ late * 1}; 
(len tt Socket .GetPacketBytes[b]) => {Wr i teChar[ '#]; late *• late + 1); 
ENDCASE => 

FOR i: CARDINAL IN [4.. len - 4) DO 

IF body.echoBytes[i] it (i MOD 400B) THEN 
(wrong *■ wrong + 1; Wri teChar['-]; EXIT}; 

REPEAT FINISHED => {WriteChar[' !]; recv «■ recv - 1}; 

ENDLOOP; 

NSBuffer,ReturnBuffer[b]; 

EXITS late -> {WriteChar['?]; late «- late +■ 1}: 

END; 

ENDLOOP; 

NewLine[]; 

ENDLOOP; 

Socket.Delete[mySoc]; 

WriteString["Out: "L]; 

WriteLongNumber[$ent]; 

WriteStr1ng[", In: "L]; 

WriteLongNumber[recv]; 

Wr1teString[" ("L]; 

WriteLongNumber[(recv*100)/sent]; 

WriteLine["%)"LJ; 

IF late ft 0 THEN { 

WriteString["Late: ”L]; WriteLongNumber[late]; 

WriteString[" ("L]; WriteLongNumber[(late*100)/sent]; WriteLine["%)"L]}; 

IF funny ft 0 THEN (Wr i teLongNumber[funny]; WriteLine[" funny”L]}; 

IF wrong ft 0 THEN {WriteLongNumber[wrong]; WriteLine[" wrong data"L]}; 

END; 

PrintLocalRoutingTable: PROC = 

BEGIN 

string: STRING «■ [20]; 
net: System.NetworkNumber; 

Router.FilIRoutingTable[Router.infinity]; --load 'em up 
Process.Pause[Process.SecondsToricks[2]]; 

FOR hop: CARDINAL IN[0..Router.inf inity] DO 

net <r Router, EnumerateRoutingTable[Router.startEnumeration, hop]; 

IF net - Router.endEnumeration THEN LOOP; --don’t print empties 
WriteString["Networks ”L]; 

WritelongNumber[LONG[hop]]; 

WriteString[" hops away = {"L]; 

UNTIL net - Router.endEnumeration DO 

ExtendedString.AppendNumber[@net, SIZE[System.NetworkNumber]. 3, string]; 
WriteString[string] ; string. length *• 0; Wri teChar[ 'B] ; 
net ^ Router.EnumerateRout1ngTable[net, hop]; 

IF net tt Router. endEnumeration THEN Wri teString[" . ”L]; 

ENDLOOP: 

WriteChar[’}]; 

NewLine[]; 

ENDLOOP; 

Router.FillRoutingTable[0]; --shut down the table 
END; --PrintLocalRoutingTable 

PrintNSAddress: PROC [a: POINTER TO System.NetworkAddress] = 

BEGIN 

buffer: STRING <- [GO]; 

ExtendedStrlng,AppendNumber[@a.net, SIZE[System.NetworkNumber], 8, buffer]; 
buffer[buf fer. length] buffer. length «- buf f er. 1 ength + l; 

ExtendedString.AppendNumber[@a.host, SIZE[System.HostNumber], 8, buffer]; 
buffer[buffer. length] *■ buf fer . 1 ength «- buffer. length +■ l; 

ExtendedString.AppendNumber[@a.socket, SIZE[System.SocketNumber], 8. buffer]: 
WriteString[buffer]; 

END; 

echoName: LONG STRING *- NIL; 

Commands: PROC [index: CARDINAL] = { 

SELECT index FROM 
0 => { 

MyNameIs[ 

myNamels: "Echo User"L, 
myHelpIs: "Echo user"L]; 

EchoUser[]}; 
i => c 
MyNameIs[ 

myNamels: "Routing Tables"L, 

myHelpIs: "Show NS network routing tables"L]; 

PrintLocalRoutingTable[]}; 
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ENDCASE => IndexTooLarge}; 


commandProcessor: CommandProcessor <- [Commands]; 
-- initialization 

RegIsterCommandProc[©commandProcessor]; 

END. 
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--- File: OthelloNSFTP.mesa - last edit: 

-- NFS 5-Jun-86 14:20:34 

-- bjd 23-Aug-85 16:18:16 

lgr 13-Feb-84 15:31:26 

rkj 24-Feb-84 18:36:31 

Copyright (C) 1984, 1985 by Xerox Corporation. All rights reserved. 

DIRECTORY 

AddressTranslation USING [Error, PrintError, SfringToNetworkAddress], 

Auth USING [Freeldentity, IdentityHandle, Makeldentity]. 

- -CH USING [MakeRhs], 

Courier USING [ErrorCode, Error], 

NSErrorMsg USING [PostCourierError, PostNSFi1eError], 

Heap USING [systemZone], 

Format USING [StringProc], 

NSDataStream USING [Abort, Aborted. Handle, SourceStream], 

NSFile USING [ 

AttributesProc, AttributesRecord, Close. Error, ErrorRecord, Find, GetAttributes, 
Handle, List, Logoff, LogonDirect, maxStringLength. nullHandle, nullSession, Open, 
Retrieve, Scope, Selections, ServiceRecord, Session, String, Time], 

NSName USING [ 

AppendNameToString, Error, FreeNameFields, maxDomainLength, maxFul1NameLength, 
maxOrgLength, Name, NameFieldsFromString, NameRecord, String], 

OthelloDefs USING [ 

AbortingCommand. CheckUserAbort, CommandProcessor, GetName, 

IndexTooLarge , MyNamels, RegisterCoinmandProc , SetCommandStri ng, 

SetCursor, WriteChar, WriteLine, WriteString] , 

OthelloFetch USING [ 

Destination, directory, Handle, GrabBitsFromStream, Object, Register, Select, 
StartFeedback], 

Profile USING [GetDefaultDomain, GetDefaultOrganization, GetUser, String], 

Stream USING [Delete, Handle], 

String USING [ 

AppendChar, AppendCharAndGrow, AppendNumber, AppendString, AppendStringAndGrow, 
CopyToNewString, Empty, Length, StringBoundsFault, Substring, SubStringDescriptor], 
Time USING [Append, Unpack]; 

OthelloNSFTP: PROGRAM 
IMPORTS 

AddressTranslation, Auth, Courier, NSErrorMsg, Heap, 

NSDataStream, NSFile, 

NSName, OthelloDefs, OthelloFetch, Profile, Stream, String, Time - 
BEGIN 

host: LONG STRING «- NIL: 

nsF ileSession: NSF i le .Session «- NSFi 1 e . nul ISession ; 
z: UNCOUNTED ZONE = Heap.systemZone: 


-- String/Credentials Commands 

I don't believe we need this proc anymore; It no longer make sense to allow network addresses; must get to Auth server anyway 

Qualify: PROC [token: LONG STRING] RETURNS [newToken: LONG STRING] - ( 
octa I Address: BOOLEAN *■ TRUE; -- only '0..'7 and allowed 
chChar: CHARACTER = 

defaul tDomain, defaultOrganizatlon: LONG STRING «- NIL: 

GetDomain: PROC[domain: LONG STRING] f 
(IF domain # NIL THEN 

String.AppendStringAndGrow[@defau1tDomain. domain, z]}; 

GetOrg: PROC[org; LONG STRING] = 

(IF org # NIL THEN 

String.AppendStr1ngAndGrow[@defaultOrganization, org, z]}; 

IF String.Length[token] = 0 THEN RETURN[NIL]; 

FOR i: CARDINAL IN [0..token.length) DO 
SELECT token[i] FROM 

chChar => (RETURN[String.CopyToNewString[token, z]]}; -- already qualified 
IN['0..’7], '# => NULL; 

ENDCASE => octal Address «• FALSE: 

ENDLOOP: 

newToken «- String ,CopyToNewString[token . z] ; 

IF octal Address THEN RETURN; 

Profile.GetDefaultDomain[GetDomain] ; 

Profile.GetDefaultOrganization[GetOrg]; 

IF String,Length[defaultDomain] > 0 OR 

String.Length[defaultOrganization] > 0 THEN { 

String.AppendCharAndGrow[@newToken, chChar, z]; 

String.AppendStringAndGrow[0newToken. defaultDomain. z]; 

String.AppendCharAndGrow[@newToken, chChar, z]; 

String,AppendStringAndGrow[@newToken, defaultOrganization, z ]}; 
z.FREE[0defaultOomain]; 
z.FREE[@defaultOrganization]}; 

Dolndirect: PROC [cmFile: LONG STRING] RETURNS [mine: BOOLEAN] = 

BEGIN 

f IleName: LONG STRING «• NIL; 

ParseCmFileName: PROC = { 
hostEnd: CARDINAL: 

IF cmFile.length = 0 THEN RETURN: 

FOR i: CARDINAL IN [0..cmFi1e.1ength) DO 
c: CHARACTER = cmFile[i]; 

SELECT c FROM 

'[ => LOOP; ’] --> {hostEnd «- 1; EXIT}; 

ENDCASE => String.AppendCharAndGrow[@host. c, z]; 
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REPEAT FINISHED => {z.FREE[@host]; RETURN} 

ENDLOOP; 

-- hostEnd points at '] 

FOR i: CARDINAL IN (hostEnd..cmFi1e.1ength) DO 

IF cmFile[i] 2 '< AND OthelloFetch.directory#NIL THEN 
Othel loFetch.directory.length «■ 0; 

String,AppendCharAndGrow[@fileName. cmF11e[i], z]; 

IF cmFile[i] = '> THEN { 

String.AppendStringAndGrow[ 

SOthel1oFetch.directory, fileName, zj; 
fileName. length *■ 0}; 

ENDLOOP}; 

s; LONG STRING <- NIL; 

GetString: PROC [c; LONG STRING] = (s <- String. CopyToNewString[c, z]}: 

IF cfflF11e[0] » ’[ THEN RETURN [FALSE]; 
z.FREE[@host]; 

z .FREE[@OthelloFetch.directory]; 

ParseCmFileName[]; 

OthelloFetch.Select[@fetcher]; Open[]; 

Retrieve[fileName, [str1ng[GetString]j 

! UNWIND => (z.FREE[@s]; z.FREE[@fi1eName]}]; 

OthelloDefs .WriteLine["done''L]; 

OthelloDefs.SetCommandString[s]; 
z.FREE[@fileName]; 

RETURN[TRUE] 

END; 


- MISC Stuff/Commands 

userOpened; BOOLEAN *- FALSE; 

OpenCmd: PROC = { 

OthelloDefs.MyNamels[ 

myNamels: "Open Connection"L. 

myHelpIs: "Open connection to file service"L]; 

OthelloFetch.Select[@fetcher]; 

OthelloDefs.GetName["Open connection to "L, ©host]; 

Open[]; userOpened *■ TRUE}; 

ReOpen: PROC RETURNS [BOOLEAN] = ( 

IF userOpened=FALSE THEN RETURN[FALSE]; 

Open[]; RETURN[TRU£]}; 

RemoteL1st: PROC [fileName; LONG STRING] = { 

IF -ConnectionOpen[] AND ~ReOpen[] THEN 
OthelloOefs.AbortingCommand["Plea$e open a connection"L]; 
ListFi1e$[IF String.Length[fileName] = 0 THEN "*”L ELSE fileName]}; 


-- Central commands 


commandProcessor: Othel loOefs .CommandProcessor <- [FtpCommands]; 

FtpCommands; PROC [index: CARDINAL] = { 

SELECT Index FROM 
0 => OpenCmd[]; 

ENDCASE => Othel1oDefs.IndexTooLarge}; 

fetcher: OthelloFetch.Object *■ [ 

Retrieve: Retrieve, 

Dolndirect: Dolndirect, 

List; RemoteList, 

Close: Close]; 


-- file retrieval Stuff/Commands 

ConnectionOpen: PROC RETURNS [BOOLEAN] = { 

RETURN[nsFileSession # NSFi1e.nul1Session]}; 

-- all callers close the connection first 
Open: PROC - { 

clientOefaultsRecord: NSName.NameRecord; 

defaultCHOrg: LONG STRING = [NSName.maxOrgLength]; 

defaultCHDomain: LONG STRING = [NSName.maxDomainLength]; 

serviceName: LONG STRING «- [NSName .maxFul INameLeng th] ; 

serviceRec: NSFi 1 e . ServiceRecord *■ []; 

nameRecord: NSName . NameRecord «• []; 

id: Auth. IdentityHandle «■ NIL; 

GetDomain: PROC[domain: LONG STRING] = [ 

String.AppendString[defaultCHDomain, domain ! 

String.StringBoundsFault => RESUME[NIL]]}; 

GetOrg: PR0C[org: LONG STRING] = { 

String.AppendString[defaultCHOrg, org ! 

String.StringBoundsFault => RESUME[NIL]]}; 

AppendNameToStrlng: PROCEDURE [s: LONG STRING, name: NSName.Name] = { 
newS: NSName. Stri ng «* NSName . AppendNameToStri ng[s : S[s], name: name]; 
s. length +- newS. 1 ength} ; 

CopyUserAndPassword: PROCEDURE[name, password; LONG STRING] = { 
userName «- String .CopyToNewString[name , z]; 
userPassword «- String.CopyToNewString[password, z]; 

>: 

Cleanup: PROCEDURE = [ 

Auth.Freeldentity[@1d, z]; 
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z .FREE[@userName]; z.fREE[@userPassword]; 

NSName.FreeNameFields[z, ©serviceRec.name]; 

NSName.FreeNameFields[z, ©nameRecord]}; 

userName, userPassword: Profile.String «■ NIL; 

IF nsFileSession ft NSFi le . null Session THEN RETURN; 

Profile.GetDefaultDomain[GetDomain]; 

Proflie.GetDefaultOrganization[GetOrg]; 

clientDefaultsRecord «- [domain: SfdefaultCHDomain]. org: S[defaultCHOrg]]; 

NSName.NameFieldsFromString[ 

z: z, s: S[ho$t], destination: ©serviceRec.name, 
clientDefaults: ©clientDefaultsRecord ! 

NSName.Error => OthelloDefs,AbortingCommand["inegal host name"L]]; 

AppendNameToString[serviceName, ©serviceRec.name]; 

Profile,GetUser[CopyUserAndPassword, clearinghouse]: 

NSName.NameFieldsFromString[ 

z: z. s: S[userName], destination: ©nameRecord, 
clientDefaults: ©clientDefaultsRecord ! 

UNWIND => NSName.FreeNameFields[z, ©serv iceRec.name]; 

NSName.Error => Othel1oDefs.AbortingCommand[”11 legal login name"L]]; 

id «- Makeldentity[name: ©nameRecord, password: userPassword]; 

[ENABLE UNWIND => Cleanup[]; 

serviceRec. systemElement «- AddressTrans I at ion. Stri ngToNetworkAddress[ 
s: serviceName, id: id ! 

AddressTranslation.Error => [ 
msg: LONG STRING <- [100]; 
appendErrorMsg: Format.StringProc = { 

String.AppendString[msg, s ! String.StringBoundsFauIt => RESUME[NIL]]}; 
AddressTranslat ion.PrintError[error: errorRecord. proc: appendErrorMsg]; 
OthelloDefs.AbortingCommand[msg]}].addr; 

nsFileSession NSFile.LogonDirect[ 

identity: id, service: ©serviceRec 
! NSFile.Error => NSError[error]; 

Courier.Error => CourierError[errorCode]]; 

Cleanup[]}}; 

Makeldentity: PROC [name: NSName.Name, password: LONG STRING] 

RETURNS [ident: Auth.IdentityHandle] = { 

ident «■ Auth .Makeldenti ty[ 
myName: name, password: S[password], 
z: z, style: simple, dontCheck: TRUE]}; 


Close: PROC - f 

IF ~ConnectionOpen[] THEN RETURN; 

NSFi 1e.Logoff[nsFi1eSession 

! NSFile.Error => NSError[error]; 

Courier.Error => CourierError[errorCode]; 

OthelloDefs.AbortingCommand => { 

Othel1oDefs.WriteString[reason]; 

Othel1oDefs.WriteLine[reasonOne]; 

CONTINUE}]; 

nsFileSession «- NSFi le . nul ISession ; 

Othel1oDefs.WriteLine["connection closed"L]}; 

-- could mess with directories. 

— who cares 

ListFiles: PROC [pattern: LONG STRING] 3 { 
scope: NSFile.Scope <- []; 
selections: NSFile.Selections «- []: 
fh: NSFile.Handle; 
dir: LONG STRING <- NIL; 
wi 1 dCardlnF ileName : BOOLEAN <- FALSE; 
name: LONG STRING <- NIL: 

ss: Stri ng, SubStri ngDescriptor «- [base: NIL, offset: 0, length: 0]; 

ListOne: NSFile.AttrlbutesProc = { 
version: LONG STRING [20]; 
time: LONG STRING <- [20]; 

Time.Append[time, Time.Unpack[attributes.createdOn]]; 

String.AppendChar[version, ’!]; 

String,AppendNumber[vers ion, attributes.version]; 

<< FOR i: CARDINAL IN [0..attributes.pathname.1ength) DO 

OthelloDefs.WriteCbar[VAL[attributes.pathname.bytes[i]]]: 

ENDLOOP;>> 

OthelloDefs,WriteString[dir]; 

FOR i: CARDINAL IN [0..attributes.name.length) DO 
Othel1oDefs.WriteChar[VAL[attributes.name.bytes[i]]]; 

ENDLOOP; 

OthelloDefs.WriteString[version]; 

THROUGH [dir.length +■ attributes . name. I ength + version-, length . .80-time . length) 
DO OthelloDefs.Wr1teChar[' ] ENDLOOP; 

OthelloDefs.WriteLine[time]; 

--OthelloDefs,Wr1teChar[' ]; 

--OthelloDefs.WriteLine[info.author]; 

--Othel1oDefs.WriteChar[' ]; 

--Othel loDefs .WriteLongNuniber[ info .size]; 

--Othel 1 oDefs .WriteLine['' bytes]"L] : 

OthelloDefs.CheckUserAbort[]; 

RETURN}; 

dir *- z . NEW[Str i ngBody[60]] ; 

IF pattern[0] # '< AND String. Length[Othel loFetch. directory] ft 0 THEN [ 

String.AppendStringAndGrow[@dir, OthelloFetch.directory , z]; 

IF dir[dir. length - l] tt '> THEN 

String.AppendCharAndGrow[@dir, ’>, z]}; 

String.AppendStringAndGrow[@dir, pattern, z]; 
ss,base dir; 
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FOR i: CARDINAL DECREASING IN [0..dir.length) DO 
SELECT dir[i] FROM 

'* = > wildCardlnFileName *• TRUE; 

’> => [ss.length «■ i + 1; EXIT); 

ENDCASE; 

ENDLOOP; 

name <■ z.N£W[StringBody[dir. length - ss.length]]; 

FOR i: CARDINAL IN [ss.length .. dir.length) DO 
String.AppendChar[name, dir[i]]; 

ENDLOOP; 

dir.length *■ ss.length; 

IF HasWildCard[dir] THEN { 
z.FREE[@dir]; 
z.FREE[@name]; 

OthelloDefs.AbortingCommand["No wild cards in d1 rectories.”L]}; 
fh «- GetFileFromSS[ss]; 

IF fh - NSFile.nul1 Handle THEN { 

z.FREE[@name]; z.FREE[@dir]; RETURN}; 
scope.filter *■ IF wildCardlnFileName THEN 
[matches[[name [S[name]]]]] 

ELSE [equal[[name [S[name]]]]]; 
selections . 1nterpreted[name] *■ TRUE; 
selections . interpreted[version] *- TRUE; 
sel ections . interpreted[createdOn] «- TRUE; 

selections. interpreted[pathname] «• TRUE; -- not yet implemented 
NSFile.List[ 

directory: fh, proc: LlstOne, selections: selections, scope: scope, 
session: nsFi1eSession 

! NSFile.Error => NSError[error]; 

Courier.Error => CourierError[errorCode]; 

UNWIND => [z.FREE[@name]; z . FREE[@dir]}]; 
z.FREE[@dir]; 
z.FREE[@name]; 

}: 

Retrieve: PROC [ 

fileName: LONG STRING, destination: OthelloFetch.Destination] = [ 
size: LONG CARDINAL; 
name: LONG STRING +■ NIL; 
fH : NSFi le .Handle *• NSFi 1 e . nul 1 Handl e : 

Sink: PROC [source: NSDataStream.SourceStream] = 

BEGIN ENABLE [ 

NSDataStream.Aborted => [Stream.Delete[$ourceJ; CONTINUE): 

UNWIND => Stream,Delete[source]}; 

OthelloFetch.GrabBitsFromStream[source. size, destination, name 1 
OthelloFetch.StartFeedback => { 

OthelloDefs,WriteString["Fetchlng..."L]; 

OthelloDefs.SetCursor[ftp]; 

RESUME}; 

UNWIND => { 

OthelloDefs.SetCur$or[pointer]; 

NSDataStream.Abort[source ! NSDataStream.Aborted = > CONTINUE]}]; 

Stream.Delete[source ! NSDataStream.Aborted => CONTINUE] 

END: 

[fH, size, name] GetFi 1 e[f i leName]; 

NSFile.Retr1eve[fH, [proc [Sink]], nsFileSession 
! UNWIND => 

[NSFile.Ciose[ 

fH, nsFileSession ! NSF1le.Error, Courier.Error -> CONTINUE]; 
z.FREE[@name]}]; 

NSFiie.Close[fH, nsFileSession 

! NSFi1e.Error, Courier.Error -> CONTINUE; 

UNWIND => z.FREE[@name]] ; 
z.FREE[@name]; 

Othel1oDefs.SetCursor[pointer]}; 

GetFile: PROC [fileName: LONG STRING] RETURNS [fh: NSFile.Handle, size; LONG CARDINAL, 
BEGIN 

time: LONG STRING <- [20]; 
attributes: NSFile.AttributesRecord; 

ss: String.SubStringDescriptor *■ [base: NIL, offset: 0, length: 0]; 
name «- z.NEW[StringBody[60]]; 

String.AppendChar[name, '[]; 

String.AppendStringAndGrow[@name. host, z]; 

String.AppendCharAndGrow[@name, '], z]; 
ss.offset «- name, length; 

IF fileName[0] ft '< AND -String.Empty[Othel loFetch ,di rectory] THEN [ 

String.AppendStringAndGrow[@name, Othel1oFetch.directory, z]; 

IF name[name. length - 1] ff ’> THEN 
String.AppendCharAndGrow[@name, ’>. z]}; 

String.AppendStringAndGrow[@name, fileName, z]; 
ss.base «- name; 

ss.length «- name.length - ss.offset; 
fh «- GetFileFromSS[ss] ; 

NSlFi le.GetAttributes[ 

fh. [[createdOn; TRUE, sizelnPages: TRUE]], 

Oattributes, nsFileSession 

! NSFile.Error => NSError[error]; 

Courier.Error => Cour1erError[errorCode]]; 

String.AppendStringAndGrow[@name, " ("L, z]; 

Time.Append[time, Time.Unpack[attributes.createdOn]]; 

String.AppendStringAndGrow[@name, time, z]: 

String. AppendCharAndGrow[@name, '), z]; 
size <- attributes . sizelnPages ; 

END; 

GetFileFromSS: PROCEDURE [ss: String.SubStringDescriptor] RETURNS [fh: NSFile .Handle 


name: LONG STRING] = 


NSFile.nullHandle] ■= [ 
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ENABLE {NSFile.Error => NSError[error]; 

Courier.Error => CourierError[errorCode]}; 
tempName: STRING = [NSFile.maxStringLength]; 

parent: NSFile .Handle + NSFile. Open[attributes: NIL. session: nsFileSession]; 
DO 

GetRoot[Qss, tempName]; 
fh + NSFile.Find[ 
directory: parent, 
scope: [ 

direction: backward, filter: [equal[[name[S[tempName]]]]]]. 
controls: [timeout: 4], session: nsFileSession ! 

UNWIND => NSFile.Close[parent, nsFileSession ! 

NSFi1e.Error, Courier.Error => CONTINUE]]; 

NSFile.Close[parent, nsFileSession]; 

IF ss.length = 0 THEN EXIT; 

parent + fh 

ENDLOOP; 

}; 

GetRoot: PROC [fileName: String.Substring, root: LONG STRING] = { 

OPEN fileName: 

St.ripChar: PROC = INLINE {offset + offset + 1; length + length - 1}; 

N: CARDINAL + offset + length; 
quote: CHARACTER = 
i: CARDINAL «- offset; 
root.length + 0 : 

WHILE i < N DO 

SELECT ba$e[iJ FROM 
quote => { 

i <- 1 + 1; StripChar[]; IF i = N THEN EXIT; 

String.AppendChar[root. base[i]]}; 

'/ => EXIT; 

'< => root.length + 0: 

ENDCASE => String.AppendChar[root, base[i]]; 
i + 1+1; 

StripChar[]; 

ENDLOOP; 

IF fileName.length = 0 THEN RETURN; 

StripChar[]}; 

S: PROCEDURE [s: LONG STRING] RETURNS [NSFile.String] - { 

IF s = NIL THEN RETURN[[bytes: NIL. length: 0. maxlength: 0]]; 

RETURN[[bytes: LOOPHOLE[@s.text], length: s.length, maxlength: s.maxlength]]}; 

HasWi1dCard: PROC [s: LONG STRING] RETURNS [BOOLEAN] = [ 

IF stfNIL THEN FOR i: CARDINAL IN [0..s.length) DO 
IF s[i] = '* THEN RETURN[TRUE] ENDLOOP; 

RETURN[FALSE]}; 


NSError: PROC [error: NSFile.ErrorRecord] = 

BEGIN 

post: Format.StringProc = [OthelloDefs.WriteString[s]} : 
NSErrorMsg.PostNSFi1eError[error, post] : 

Othel1oDef s.AbortingCommand[NIL]; 

END; 

CourierError: PROC [error: Courier.ErrorCode] = 

BEGIN 

post: Format.StringProc = (OthelloDefs.WriteString[s]} : 
NSErrorMsg.PostCourierError[error, post]; 

OthelloDefs.AbortingCommand[NIL]; 

END: 

«StartCH: PROCEDURE = { 

frame: PROGRAM <- Runtime .Global Frame[LOOPHOLE[CH .MakeRhs] ]; 
START frame};>> 


-- initialization 

OthelloDefs.RegisterCommandProc[@commandProcessor]; 
OthelloFetch.Register[@fetcher]; 

- StartCH[]; 

END..... 


Log 

NFS 4-Jun-86 13:04:55 Adapted for OthelloTool. 
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-- Copyright (C) 1986 by Xerox Corporation. All rights reserved. 
Othel loToolDefs .mesa 

Created by NFS 4-Jun-86 10:49:17 

DIRECTORY 

TTY USING [Handle], 

Volume USING [ID]; 

Othe HoToolDefs:DEFINITIONS = { 

tty: TTY.Handle: 

Run: PROCEDURE: -- instead of PilotClient.Run 
CloseVolume: PROCEDURE[volume: Volume.ID]; 

}■ 
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-- Copyright (C) 1986 by Xerox Corporation. All rights reserved. 

OthelloToolImpl.mesa 

-- Created by NFS 4-Jun-86 10:26:30 

DIRECTORY 

Exec USING [AddCommand, ExecProc, RemoveCommand]. 

OthelloToolDefs USING [Run], 

Process USING [Abort], 

Runtime USING [GetBcdTime], 

String USING [AppendString], 

Time USING [Append, Unpack], 

Tool USING [Create, Destroy, MakeSWsProc, MakeTTYSW, UnusedLogName], 

ToolWindow USING [Activate, TransitionProcType], 

TTY USING [Handle] , 

TTYSW USING [GetTTYHandle], 

Version USING [Append], 

Volume USING [Close, ID, systemID], 

Window USING [Handle]: 

OthelloToolImpl: PROGRAM 
IMPORTS 

Exec, Runtime, String, OthelloToolDefs, Process. Time, 

Tool, ToolWindow, TTYSW, Version, Volume 
EXPORTS OthelloToolDefs = { 

tty: PUBLIC TTY.Handle; 

toolWindow: Window.Handle; 

Commandlnterpreter: PROCESS; 

Init: PROCEDURE = { 
name: LONG STRING «• [75]; 
name. length *■ 0 : 

String.AppendStr ing[name, "Othel loTool "Lj; 

Version.Append[name]; 

String.AppendString[name," of "L]; 

Time.Append[name.Time.Unpack[Runtime.GetBcdTime[]]]; 
toolWindow e Tool.Create[ 

name: name, makeSWsProc: MakeTTYSW, clientTransition: Stop, 
cmSectlon: "OthelloTool"L. tinyNamel: "Othello"L, tinyName2: "Tool"L]; 

Exec. AddConimandfname : "OthelloTool.-"L, proc: Activate, unload: DestroyToo I ] ; 

}; 


Stop: ToolWindow.TransitionProcType = { 
IF new = inactive THEN { 

Process.Abort[CommandInterpreter]; 
JOIN Commandlnterpreter;}; 


Activate: Exec.ExecProc = (ToolWindow.Activate[toolWindow]; 

DestroyToo!: Exec.ExecProc = ( 

Exec.RemoveCommand[h, "OthelloTool.~"L]; 

Tool.Destroy[tooIWindow]; 


MakeTTYSW: Tool.MakeSWsProc = ( 
logName: LONG STRING <- [20]; 
ttySW: Window.Handle; 
logName.1ength «- 0; 

Tool.UnusedLogName[unused : logName, root: "OthelloTool.log"L]; 
ttySW «- Tool .MakeTTYSW[window:window, name : 1 ogNanie ]; 
tty *• TTYSW.GetTTYHandle[ttySW]; 

Commandlnterpreter *■ FORK Othel loToolDefs .Run[] ; 


C'loseVolume: PUBLIC PROCEDURE[volume: Volume.ID] = { 

IF volume ft Volume . systemID THEN Volume ,Close[volume];} ; 

Init[]; 
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~~ File: VolumelnitCommandlmp1.mesa - last edit: 

NFS 4-Jun-86 11:23:33 

-- BJD .PA 15-Feb~85 16:22:59 


-- 

RXJ 

12-Sep-83 

22:47:20 

— 

RSF 

14-Dec-83 

15:20:28 

-- 

DWE 

13-Jan-84 

11:27:06 


LXR 

3 l-Jan-84 

16:44:47 


Copyright (C) 1981, 1982, 1983, 1984 , 1985 by Xerox Corporation, All rights reserved. 
-- This file is the command Processor. 

DIRECTORY 

File USING [Error, ErrorType, Unknown], 

Format USING [HostNumber, StringProc], 

Frame USING [Free, ReadLocalWord], 

Heap USING [systemZone], 

Inline USING [BITNOT, HighHalf, LowHalf], 

OthelloDefs, 

OthelloOps USING [ 

GetTimeFromTimeServer, IsTimeValid, 

SetProcessorTime, TimeServerError], 

OthelloToolDefs USING [tty], 

PhysicalVolume USING [Error, ErrorType, NeedsScavenging], 

PilotClient USING [], 

PrincOps USING [frameSizeMap, LocalFrameHandle , LocalOverhead], 

Process USING [Pause, SecondsToTicks], 

Runtime USING [GetBcdTime, IsBound], 

SpecialRuntime USING [GetCurrentSignal], 

SpecialSpace USING [realMemorySize], 

SpecialSystem USING [GetProcessorlD], 

Scavenger USING [Error, ErrorType], 

String USING [ 

AppendChar, AppendCharAndGrow. AppendDecimal, AppendLongNumber, 

Equivalentsubstring, InvalidNumber, StringBoundsFault, StringToNumber. 

SubStringDescriptor, Uppercase], 

System USING [ 

GetGreenwichMeanTime, GreenwichMeanTime, gmtEpoch. 

Local TimeParameters, GetLocalTimeParameters . SetLocalTimeParameters]. 

TTY USING [ 

B1inkDisplay, CharsAvailable, GetChar, Handle, 

PutChar, PutString, RemoveCharacter, ResetUserAbort, UserAbort], 

Time USING [ 

Append, defaultTIme, Invalid, Pack, Unpack, Unpacked, useGMT, useSystem], 

UserTerminal USING [ 

CursorArray, GetCursorPattern. SetCursorPattern], 

Version USING [Append], 

VersionExtras USING [AppendCopyright], 

Volume USING [ 

InsufficientSpace, NeedsScavenging, NotOpen, Readonly, Unknown], 

VolumeConversion USING [Error. ErrorType]; 

UtiIityPilotClientlmpl: PROGRAM 
IMPORTS 

File, Format, Frame, Heap, Inline, OthelloDefs, OthelloOps, OthelloToolDefs, 
PhysicalVolume, Process, Runtime, SpecialRuntime, SpecialSpace, SpecialSystem, 
Scavenger, String, System, Time, TTY, UserTerminal. 

Version, VersionExtras, Volume, VolumeConversion 
EXPORTS OthelloDefs, OthelloToolDefs = 

BEGIN 

MyNameIs: PUBLIC SIGNAL [ 

myNamels: LONG STRING, myHelpIs: LONG STRING] - CODE: 

Abort!ngCommand: PUBLIC ERROR [ 

reason: LONG STRING, reasonOne: LONG STRING <- NIL] = CODE: 


IndexTooLarge: PUBLIC ERROR = 

CODE 

Question: 

PUBLIC SIGNAL = 

CODE 

F ryAgain: 

PUBLIC SIGNAL = 

CODE 

BS: 

CHARACTER 

= 

IOC; 



ControlA: 

CHARACTER 

= 

’A - 

1008 ; 


ControlP: 

CHARACTER 

= 

•P - 

1006; 


Contro1W: 

CHARACTER 

= 

’W - 

100B; 


CR: 

CHARACTER 

= 

15C; 



OEL: 

CHARACTER 

= 

177C 



ESC: 

CHARACTER 

= 

33C ; 



SP: 

CHARACTER 

= 

' ; 



NUL: 

CHARACTER 

= 

OC; 




CommandProcessor: TYPE = OthelloDefs.CommandProcessor; 


-- Commands 


CurrentComand: SIGNAL RETURNS [ 

proc: PROC [index: CARDINAL], index: CARDINAL] = CODE; 

ForAlICommandProcs: PROC [P: PROC[LONG STRING]] = { 

FOR c: LONG POINTER TO CommandProcessor «- commands, c.next WHILE c # NIL DO 
FOR i: CARDINAL IN [0..LAST[CARDINAL]) DO 
ENABLE CurrentComand => RESUME[c.proc, 1]; 
c.proc[i 

! MyNamels = > [P[myNameIs]; CONTINUE}; 

IndexTooLarge => EXIT]; 

ENDLOOP ENDLOOP}; 

Help: PROC = { 
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WidthProc: PROC [s: LONG STRING] = (tabWIdth MAX[tabWidth, $. length]}; 
tabWidth: CARDINAL <- 0; 

SIGNAL MyNameIs[myNameIs: "He1p"L, myHelpIs: "Type this table"L]; 

ForA11 CommandProcs[WidthProc]; 
tabWidth «- tabWidth + 4; 

FOR c: LONG POINTER TO CommandProcessor *■ commands, c.next WHILE c ft NIL DO 
FOR i; CARDINAL IN [0..LAST[CARDINAL]) DO 
c .proc[i 
! MyNamels => { 

WrlteString[myNameIs]; 

THROUGH [myNamels.length..tabWidth) DO WriteChar[' ] ENDLOOP; 
WriteLine[myHelpIs]; 

CONTINUE}; 

IndexTooLarge => EXIT]; 

ENDLOOP ENDLOOP; 

WriteLine[ 

"In General, Del will abort current command. ? will explain options"L]}; 

TimeUser: PROC [index: CARDINAL] = { 

SELECT index FROM 
0 => { 

SIGNAL MyNameIs[myNameIs: "Time"L. myHelpIs: "Time of day"L]; 

WrlteString["Current t1me"L]; WriteTime[Time.defaultTime, TRUE]}: 

1 => 

Help[]; 

ENDCASE => 

ERROR IndexTooLarge}; 

RegisterCommandProc: PUBLIC PROC [ 

commandProc: LONG POINTER TO CommandProcessor] = { 
comniandProc. next «- commands; commands «- commandProc}; 

commands: LONG POINTER TO CommandProcessor *- OhelpCommandProcessor: 
he IpCommandProcessor: CommandProcessor «- [TimeUser, NIL]; 


-- Basic command processing 

CollectCommand: PROC RETURNS [ 

p: PROC [index: CARDINAL], index: CARDINAL] - { 

ExplainOptions: PROC = { 
first: BOOLEAN <- TRUE; 

WriteChar['?]; 

IF userString.length ff 0 THEN { 

P: PROC [s: LONG STRING] = { 

IF HeadMatch[$, userString.length] THEN ( 

WriteString[IF first THEN "\rCurrent Options Are: "L ELSE ", "L]; 

WriteString[s] ; first «- FALSE}}; 

ForAI1 CommandProcs[P]}; 

IF first THEN { -- Didn't match... tell all 

P: PROC [s: LONG STRING] = { 

IF -first THEN WriteString[" . "L]; WriteString[s]; first «- FALSE}; 

WriteString["\rValid Commands Are: "L]; 

ForAIlCommandProcs[P]}; 

WriteString["\r> "L]; WriteString[userString]}; 

FindAnswer: TYPE = RECORD [ 

SELECT how: * FROM none => NULL, many => NULL, 

one => [proc: PROC [index: CARDINAL], index: CARDINAL], 

ENDCASE]; 

FindPossibles: PROC RETURNS [ans: FindAnswer *- [none[]]] - { 

P; PROC [matchstring: LONG STRING] = { 

IF HeadMatch[matchString, head] THEN 
WITH ans SELECT FROM 
none = > { 

ans «- [one[CurrentComand[]. proc , CurrentComand[ ]. index]]; 

UNTIL userString.1ength = matchstring.length DO 

userStri ng[userSt ring .length] *■ mat chString[ userString .length] ; 

IF (userString. length «- userString. length +■ 1) = userString .maxlength THEN { 
WriteL1ne[" Command too long!"L]; ERROR TryAgain} 

ENDLOOP}; 

ENDCASE => { 

--ASSERT[headrfO] 

FOR i : CARDINAL IN [head - 1..LAST[CARDINAL]) DO 

IF LowerCase[userString[i]] # LowerCase[matchString[i]] THEN { 
userString. 1 ength <- i; EXIT}; 

ENDLOOP; 

ans <- [many[]]}}; 

head: CARDINAL *- userString . 1 ength ; 

IF head = 0 THEN RETURN; 

ForAllCommandProcs[P]; 

WHILE head If userString. 1 ength DO 

WriteChar[userString[head]]; head <- head + 1 ENDLOOP}: 

HeadMatch: PROC [matchString: LONG STRING, head: CARDINAL] 

RETURNS [BOOLEAN] = { 

IF head > matchString.length THEN RETURN[FALSE]; 

FOR i: CARDINAL IN [0..head) DO 

IF LowerCase[userString[i]] ff LowerCase[matchString[ i]] THEN 
RETURN[FALSE] 

ENDLOOP; 

RETURN[TRUE]}; 

Lowercase: PROC [c: CHARACTER] RETURNS [CHARACTER] = { 

RETURN[IF c IN ['A..'Z] THEN c + ('a - 'A) ELSE c]}; 

userString: STRING = [100]; 

userString, length *■ 0; 

WriteString["> "L]; 
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DO 

c: CHARACTER = ReadChar[]; 

SELECT c FROM 

DEL => (WriteLine[" XXX"L]; ERROR TryAgain}; 

BS, ControlA => IF userString.1ength tf 0 THEN 

EraseTTYChar[userString[userString.1ength «- userString . 1 ength - 1]]; 

ControlW => 

IF userString.length # 0 THEN DO 

EraseTTYChar[userString[userString . length <- userString. 1 ength - 1]]; 

IF userString.length=0 OR userString[userString.1ength 1] = SP THEN EXIT 
ENDLOOP; 

'? => ExplainOptions[]; 

CR. SP => { 

ans: FindAnswer = FindPossib1es[]; 

WITH theAns: ans SELECT FROM 
none => ( 

IF Runtime.IsBound[LOOPHOLE[Othe11oDefs.A1ternateGetCMFile]] 

AND userString.length > 1 AND userString[0] = THEN { 

NewLine[]; 

Othel1oDefs,A1ternateGetCMFile[userString 
! OthelloDefs.MyNamels => RESUME]; 

ERROR TryAgain}; 

IF prometheusBound THEN AbortingCommand["Script Error"L] 

ELSE B1inkDi$play[]}; 
many => NULL; 

one => RETURN[theAns.proc, theAns.index]; 

ENOCASE => ERROR}; 

ENDCASE => 

IF (userStr i ng. length *• userString. length 1) = userStri ng .maxlength THEN { 
Wr1teL1ne[" Command too long!”L]; ERROR TryAgain} 

ELSE WriteChar[userString[userString.length - 1] «■ c]; 

ENDLOOP}; 


--- Utility-Type Functions 

Confirm: PUBLIC PROC [how: Othel 1 oDef$.ConfirmType «■ once] = { 

IF CommandF11eActive[] THEN RETURN: 

WriteString["Are you "L]; 

IF how = thrice THEN WriteString["still "L]; 

WriteString["sure? [y or n]: "L]; 

DO 

c: CHARACTER = ReadChar[]; 

SELECT c FROM 

'y. 'Y, CR => [WriteLine["Yes"l]; EXIT}; 

’n, ’N. DEL => (WriteLine["No"L]; ERROR TryAgain}; 

ENDCASE => B1inkD1splay[]; 

ENDLOOP; 

IF how = twice THEN { 

Process.Pause[Process.SecondsToTick$[3]]: Flushlnput[] ; Confirm[thrice]}}; 

DcbugAsk: PUBLIC PROC = [ 

WriteString["\rType ControlP to muddle on."L]; 

WHILE ReadChar[] # ControlP DO ENDLOOP: NewLine[]}; 

spacesInStringOK: BOOLEAN «• FALSE: 

GetName; PUBLIC PROC [ 

prompt; LONG STRING «- NIL. dest: LONG POINTER TO LONG STRING, 

how: Othel loDefs. EchoNoEcho *■ echo, s ignalQuestion: BOOLEAN «- FALSE] = 

BEGIN 

first: BOOLEAN «• TRUE: 

EraseChar: PROC = { 

IF dest.length = 0 THEN RETURN; 
dest.length <- dest.length - 1; 

EraseTTYChar[IF how = echo THEN dest[dest.1ength] ELSE 1 f ]; 

IF dest.length = 0 AND dest.maxiength > 20 THEN { 

Heap . systemZone. FREE[dest] ; destt «- Heap . systemZone . NEW[Str i ngBody[ 10]]}} ; 

CWriteC: PROC [c: CHARACTER] = [WriteChar[IF how = echo THEN c ELSE **]}; 

CWriteStrIng: PROC = { 

FOR 1: CARDINAL IN [0..dest.1ength) DO CWriteC[dest[i]] ENDLOOP}; 

IF destt = NIL THEN destt ♦- Heap . systemZone .NEW[StringBody[ 10] ]; 

WriteString[prompt]; CWriteString[]: 

DO 

c: CHARACTER = ReadChar[]; 

SELECT TRUE FROM 

c = BS, c = ControlA => EraseChar[]; 

<< (c = SP AND -spacesInStringOK),>> c = CR => [NewLine[]: RETURN}; 
c = DEL => (WriteLlne[" XXX"L]; ERROR TryAgain}; 
c = ControlW => 

DO 

EraseChar[]; 

IF dest.length=0 THEN EXIT; 

SELECT dest[dest.length-1] FROM 

IN ['a..'z], IN ['A..'Z], IN ['0..’9] => LOOP; 

ENDCASE => EXIT; 

ENDLOOP; 

c = '? AND signalQuestion => [ 

SIGNAL Question; WriteString[prompt]; CWriteString[]: LOOP}; 
c >= SP => { 

IF first THEN WHILE dest.lengths DO EraseChar[] ENDLOOP; 

String.AppendCharAndGrow[dest, c. Heap.systemZone ]: CWriteC[dest[dest.length-1]]}; 
ENDCASE => B1inkOisplay[]; 
first «- FALSE; 

ENDLOOP: 

END; 
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numberstring: LONG STRING <- NIL; 

ReadNumber: PUBLIC PROC [ 

prompt; LONG STRING, min, max, default: LONG CARDINAL «■ LAST[LONG CARDINAL]] 
RETURNS [ans; LONG CARDINAL] = { 

DO 

IF default ft LAST[LONG CARDINAL] THEN { 

IF numberString^NIL THEN numberstring «• Heap.systemZone,NEW[StringBody[15]]; 
numberstring . length <- 0; String .AppendLongNumber[numberString , default, 10]}; 
WriteString[prompt]; WriteChar['[]: WriteLongNumber[min]; 

WriteStr1ng[".."L]; WriteLongNumber[max]; WriteString["]; ”L]; 

GetName[dest: GnumberString]; 
ans *■ 0; 

FOR i: CARDINAL IN [0..numberstring.length) DO 
IF numberString[i] NOT IN [’0..’9] THEN EXIT; 
ans «■ 10*ans + numberString[ i ] - '0; 

REPEAT FINISHED => IF ans IN [min..max] THEN { 

Heap.systemZone.FR£E[@numberString]; RETURN}; 

ENDLOOP; 

WriteL1ne["Bad Number !"L]; 

ENDLOOP}; 

ReadShortNumber: PUBLIC PROC [ 

prompt: LONG STRING, min, max, default: LONG CARDINAL] 

RETURNS [CARDINAL] = ( 

RETURN[Inline.LowHalf[ 

ReadNumber[prompt. min. MIN[max, LONG[LAST[CARDINAL]]], default]]]}; 

WriteFixedWidthNumber: PUBLIC PROC [ 

x: LONG CARDINAL, count: CARDINAL, base: CARDINAL «■ 10] = { 

WFD: PROC [x: LONG CARDINAL, c: CARDINAL] = { 

IF c = count THEN RETURN; 

WFD[x/base, c + 1]; 

WriteChar[IF c = 0 OR x ft 0 THEN Iniine.LowHalf[x MOD base] + '0 ELSE ’ ]}; 
WFD[x, 0]}; 

WriteLongNumber: PUBLIC PROC [num: LONG CARDINAL] - { 
s: STRING <- [40]; 
s.length «■ 0; 

String,AppendLongNumber[s, num, 10]; 

WriteString[s]}; 

WriteOctal: PUBLIC PROC [num: CARDINAL] = { 

IF num ft 0 THEN WriteOctal [num/8]: Wri teChar[ (num MOO 8) + ’0]}; 

Yes: PUBLIC PROC [s: LONG STRING] RETURNS [BOOLEAN] = { 

WriteString[s]; 

DO 

SELECT ReadChar[] FROM 

'Y, 'y, CR => (WriteLine["yes"L]; RETURN[TRUE ]}; 

N, 'n, DEL => [WriteLine["no"L]; RETURN[FALSE]}: 

ENDCASE ■=> WriteCharf?]; 

ENDLOOP}; 


-- Time munging 


string format must be: bDD-MMM-YYbbHH:MM:SSbbZZTb 
PackedTimeFromString: PUBLIC PROC [ 
s: LONG STRING, justDate: BOOLEAN] 

RETURNS [t: System.GreenwichMeanTime] = { 

Empty: PROC [s: LONG STRING] RETURNS'[BOOLEAN] = { 

RETURN[s = NIL OR s.length = 0]}; 

EquivalentChar: PUBLIC PROC [cl, c2: CHARACTER] RETURNS [BOOLEAN] * { 
RETURN[String.UpperCase[cl] = String.UpperCase[c2]]}; 

GetToken: PROC [storage: LONG STRING, s: LONG STRING, c: CARDINAL] 
RETURNS [is: CARDINAL] = { 

FOR is *■ c, is + 1 UNTIL is >= s. length DO 
ch: CHARACTER = s[is]; 

SELECT ch FROM 

IN [*a ..’z], IN [ ’ A. , ’ Z] , IN [’O..^] => 

String.AppendChar[storage, ch]; 

’- => EXIT; -- terminator 

=> IF ~Empty[storage] THEN EXIT; --terminating blank 
ENDCASE; 

ENDLOOP; 

RETURN[is + 1]}; 

Dolt: PROC [s: LONG STRING] RETURNS [t: System.GreenwichMeanTime] = { 
Get: PROC RETURNS [CARDINAL] = { 

si.length <■ 0; nextChar *- GetToken[sl, s, nextChar]; 

RETURN[sl.length]}; 

GetNumber: PROC RETURNS [CARDINAL] = [ 

[] «-Get[]; RETURN[String . Stri ngToNumber[sl, 10]]}; 
m: String.SubStringDescriptor [ 

base: "JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDECL, 

offset: NULL, length: 3]; 
si: STRING = [3]; 

month: String .SubStringDescriptor «- [ 
base: si, offset: 0, length: NULL]; 
time: Time .Unpacked *- [ 

0, 0, 0, 0, 0, 0, 0, FALSE. System.GetLocalTimeParameters[]]; 
nextChar: CARDINAL *■ 0: 
packlt: BOOLEAN «■ TRUE; 

IF En«pty[s] THEN RETURN [System. gmt Epoch] ; 
time.day *- GetNumber[]; 
month . length «■ Get[]: 
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FOR 1: CARDINAL IN [0. . 12) DO 
m.offset «- 1*3; 

IF String.EquivalentSubString[@month, @nt] THEN { 
time.month *• 1; EXIT}; 

ENDLOOP; 

time.year *■ GetNumber[]; 

time.year *■ time.year + (IF tlme.year>68 THEN 1900 ELSE 2000); 

IF justDate THEN { 

time.hour «■ 23; time.minute «- 59; time.second <- 59} 

ELSE { 

time,hour *■ GetNumberf]; 
time.minute <- GetNumber[]; 
time.second <- GetNumber[]; 

IF Get[] ft 0 THEN { 

zones: PACKED ARRAY [5..8] OF CHARACTER - [*E. 'C. 'M, ’P]; 

FOR i: CARDINAL IN [5..8] DO 

IF EquivalentChar[s 1 [ 0 ], zones[i]] THEN {time . zone . zone «■ i; EX 

REPEAT FINISHED => time. zone . zone «- 0; GMT 

ENDLOOP: 

time.dst <- EquivalentChar[sl[ 1 j , 'DJ; 
packlt *■ FALSE}}; 
t «- Time.Pack[time, packlt]}; 
t ** DoIt[s 

! String.InvalidNumber, String.Str1ngBoundsFault, Time.Invalid => { 
t «• System.gmtEpoch; CONTINUE}]}; 

WriteTime: PROC [ 

t: System .Greenwi chMeanTime, showDay: 800LEAN «- TRUE, 
type: {system, gmt, pacific} «- system] = { 
days: ARRAY [0..7) OF STRING = [ 

"Monday"L, "Tuesday"L, "Wednesday"L, "Thursday"L, 

"Friday"L, "Saturday"L, "Sunday"L]; 
temps: STRING * [40]; 

Time.Append[temps, 

Time.Unpack[t, SELECT type FROM 

pacific => [useThese[[west, 8, 0, 121, 305]]], 
gmt => Time.useGMT, 

ENDCASE => Time.useSystem]]; 

IF showDay THEN { 

WriteChar[’ ]; WriteString[days[Time.Unpack[t].unpacked.weekday]]}; 

IF temps[0] ft ' THEN WriteChar[’ ]; 

WriteLine[temps]}; 


-- The Big Loop 
prometheusBound: BOOLEAN = 

Runtime.IsBound[LOOPHOLE[0the1loDefs.GetCannedScript]]; 

Run: PUBLIC PROC = 

BEGIN 

ENABLE ABORTED => CONTINUE; -- when deactivated 
ttyHandle *■ Othel 1 oToolDef s . tty; 

ResetAbort[]; 

PrintHerald[]; 

PrintPIDs[]; 

PrintMemorySize[]; 

GetTime[]; 

DO 

Tel 1 Error: PROC [s: LONG STRING] = { 

IF prometheusBound THEN OthelloDefs.TherelsAnError[]: 
commandlndex *■ LAST[CARDINAL]; NewLine[]; WriteString[s]}; 
p: PROC [index: CARDINAL]; i: CARDINAL; 

IF (-CommandFi1eActive[]) AND prometheusBound THEN { 

ResetAbort[]: OthelloDefs.GetCannedScript[]}; 

IF CommandFileAct1ve[] THEN 
CheckUserAbort[ 

IMyAborted => {TellError["Command File Aborted\r"L]; LOOP}] 

ELSE ResetAbort[]; 

[p, i] *- Col lectCommand[ 

! TryAgain => RETRY; 

AbortlngCommand => {Tel 1Error[reason]; WriteLine[reasonOne]; LOOP}: 
MyAborted => {Tel 1Error["Command File Aborted\r"L]; LOOP}]; 
NewLine[]; 
p[i ! 

MyNamels -> RESUME; 

MyAborted => {TellError["ABORTEO\r"L]; CONTINUE}; 

AbortingCommand => { 

Tel 1£rror[reason]; WriteLine[reasonOne]; CONTINUE}; 

File.Unknown => { 

TellError["File.Unknown"L]; DebugAsk[]; CONTINUE): 

File.Error => { 

PrintNames: PROC [x: File.ErrorType] = { 
e: ARRAY File.ErrorType OF STRING = [ 
invalidParameters: "invalidParameters"L, 
reservedType: "reservedType"L]; 

WriteString[e[x]]}; 

Tel 1Error["File.Error["L]; 

PrintNames[type]; 

WriteChar[’]]; 

DebugAsk[]; 

CONTINUE}; 

PhysicalVolume.Error => { 

PrintNames: PROC [x: PhysicalVolume.ErrorType] = { 
e; ARRAY PhysicalVolume.ErrorType OF STRING = [ 
badDisk: ,, badDisk ,, L. 
badSpotTab1eFul1: "badSpotTableFu11"L. 
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containsOpenVolumes: "containsOpenVolumes"L, 

diskReadError: "diskReadError"L, 

hardwareError: "hardwareError"L, 

hasPi 1otVolume: "hasPilotVolume"L, 

alreadyAsserted: "alreadyAsserted"L, 

insufficientSpace: "insufficientSpace"L, 

invalidHandle: "invalidHandle"L, 

nameRequired: "nameRequ1red"L, 

needsConversion: "needsConversion"L, 

notReady: "notReady"L 1 

noSuchDrive: "noSuchDrive"L, 

noSuchLogical Volume: "noSuchLogical Volume"L, 

physicalVolumeUnknown: "physicalVolumeUnknown"L. 

writeProtected: "writeProtected"L, 

wrongFormat: "wrongFormat"L]: 

WriteString[e[x]]}; 

TenError["PhysicalVolume.Error["L]; PrintNames[error]; 

WriteChar[’ ]]; 

DebugAsk[]; 

CONTINUE}: 

PhysicalVolume.NeedsScavenging => { 

Tel IError["PhysicalVolume.NeedsScavenging"L]; 

DebugAsk[]; CONTINUE}; 

Scavenger.Error ->( 

PrintNames: PROC [x: Scavenger.ErrorType] = { 
e: ARRAY Scavenger.ErrorType OF STRING = [ 
cannotWri teLog: "cannotWriteLog , 'L, 
noSuchPage: "noSuchPage"L, 
orphanNotFound: M orphanNotFound"L, 
volumeOpen: "volumeOpen"L, 
diskHardwareError: "diskHardwareError"L. 
diskNotReady: "diskNotReady"L, 
needsConversion: "needsConversion"L, 
needsRiskyRepair: "needsRiskyRepair"L]; 

WriteString[e[x]]}: 

Tel 1Error["Scavenger.Error["L]; PrintNames[errorJ; WriteChar[’]]; 

DebugA$k[]; 

CONTINUE}; 

VolumeConversion,Error =>{ 

PrintNames: PROC [x: VolumeConversion.ErrorType] - { 
e: ARRAY VolumeConversion.ErrorType OF STRING = [ 
hardwareBroken: "hardwareBroken"L, 
lostLog: "lostLog"L, 

runPreviousScavenger: "runPreviousScavenger"L, 
volumeVersionTooNew: "volumeVersionTooNew"L, 
volumeVersionTooOld: "volumeVersionroo01d"L]; 

WriteString[e[x]]}; 

Tel 1Error["VolumeConversion.Error["L]; PrintNames[error]; WriteChar[*]] 

DebugAsk[]; 

CONTINUE}; 

Volume.InsufficientSpace => { 

TellError["Volume.InsufficientSpace"L]; 

DebugA$k[]; CONTINUE}; 

Volume.NotOpen => { 

TellError["Volume.NotOpen"L]; OebugAsk[]; CONTINUE}; 

Volume.NeedsScavenging => { 

TellError["Please Scavenge the volume first"L]; CONTINUE}: 

Volume.Unknown => { 

rellError["Volume.Unknown"L]; OebugAsk[]; CONTINUE}; 

Volume.Readonly => { 

Te 11 Error["Volume . ReadOn 1 y" L] : DebugAskQ; CONTINUE}; 

String.StringBoundsFault => ( 

Te11Error["String.StringBoundsFault"L]; DebugAsk[]; CONTINUE}; 

TryAgain => CONTINUE: 

ABORTED => REJECT; 

ANY => { 

signal: SIGNAL: 

args: PrincOps.LocalFrameHandle; 

Tel 1Error["Uncaught Signal = ["L]; 

[signal: signal, signalArgs: args] +■ 

SIGNAL SpecialRuntime.GetCurrentSignal ; 

WriteOctal[Iniine.LowHalf[LOOPHOLE[signal]]]: 

WriteChar[’,]; 

WriteOctal[Iniine.HighHalf[LOOPHOLE[signal]]]: 

WriteChar[’]]; 

IF args » NIL THEN { 

size: CARDINAL <- PrincOps . frames izeMap[Frame . ReadLocal Wo rd[args]. fs i ] 
- SIZE[PrincOps.LocalOverhead]; 

WriteString[", msg = [”L]; 

FOR i: CARDINAL IN [0..size-1) DO 

WriteOctal[args[i]]; WriteString[", "L] ENDLOOP: 

WriteOctal[args[size-1]]; WriteChar[’]]: 

Frame.Free[args]}; 

DebugAsk[]; CONTINUE}]; 

ENDLOOP; 

END; 


-- TTY Interface Stuff 


useADM: BOOLEAN - FALSE: 

ttyHandle: TTY.Handle *■ Othel 1 oToolDefs . tty; 

BIinkDisplay: PUBLIC PROC = [TTY,B1InkDisplay[ttyHand 1e]}; 
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MyAborted: ERROR = CODE; 


CheckUserAbort: PUBLIC PROC = { 

IF TTY,UserAbort[ttyHandle] THEN {ResetAbort[]; ERROR MyAborted}}; 
EraseTTYChar: PROC [c: CHARACTER] = { 

SELECT c FROM IN [' ..'-] => NULL; CR => RETURN; ENDCASE => EraseTTYChar[' ]; 
TTY.RemoveCharacter[ttyHandle];}; 

ReadChar: PUBLIC PROC RETURNS [c: CHARACTER] - { 
gotlt: BOOLEAN; 

[gotlt, c] <- GetCommandFileCharacter[]; 

IF gotlt THEN RETURN; 

RETURN[TTY.GetChar[ttyHandle]]}; 

SetCursor: PUBLIC PROC [c: OthelloDefs.Cursor] = { 

cursor: ARRAY OthelloOefs.Cursor OF UserTerminal.CursorArray = [ 
pointer; [ 

100000B, 140000B, 160000B, 170000B, 174000B, 176000B, 177000B, 170000B, 

I54000B, 114000B, 006000B, 006000B. 003000B, 003000B, 00L400B, 001400B], 

ftp: [ 

Q00177B, 076077B, 040037B. 040017B, 070007B, 043703B. 040401B, 040400B. 

000400B. 100436B. 14042LB, 160421B, L70036B, 174020B, 176020B, 177020B]]; 

IF ~useADM THEN UserTerminal.SetCursorPattern[cursor[c]]; 
cursorFl ipped *- FALSE}; 

cursorFlipped; BOOLEAN; 

F I ipCursor; PUBLIC PROC = { 

IF -useADM THEN { 

c: UserTerminal .CursorArray «• UserTerminal .GetCursorPattern[]; 

FOR i: CARDINAL IN [0 . . LENGTH[c]) DO c[i] <- Ini ine.BITNOT[c[i ]] ENDLOOP; 
UserTerminal.SetCursorPattern[c]j 
ELSE { 

IF cursorFlipped THEN WriteChar[BS] ELSE WriteChar[SP]; 
cursorFl ipped *• ~cursorFlipped}}; 

Flushlnput: PROC = { 

UNTIL TTY.CharsAvai1able[ttyHandle] = 0 DO 
[] «- TTY.GetChar[ttyHand1e] ENDLOOP}; 

NewLine: PUBLIC PROC = {WriteChar[CR]}; 

ResetAbort: PROC = {TTY.ResetUserAbort[ttyHandle]}; 

WriteChar: PUBLIC PROC [c: CHARACTER] = { 

IF prometheusBound AND Othel1oDefs.SuppressOutput[] THEN RETURN; 

TTY.PutChar[ttyHand1e. c]}; 

WriteLine: PUBLIC PROC [s: LONG STRING] = {WriteString[s]; NewLine[]}; 

WriteString: PUBLIC PROC [s: LONG STRING] = { 

IF prometheusBound AND OthelloDefs.SuppressOutput[j THEN RETURN; 

IF s » NIL THEN TTY.PutString[ttyHand1e, s]}; 

command: LONG STRING *• NIL; 

commandlndex: CARDINAL *■ 0; 

CommandFileActive: PROC RETURNS [BOOLEAN] = INLINE {RETURN[command#NIL ]}: 

GetCommandFi1eCharacter; PROC RETURNS [ 
isThere: BOOLEAN, c; CHARACTER] = INLINE { 

IF command # NIL THEN { 

IF commandlndex >= command.1ength THEN { 

Heap. systemZone . FREE[@comniand] ; command «■ NIL} 

ELSE { 

commandlndex *■ commandlndex + 1; 

R£TURN[TRUE, command[commandIndex-l]]}}: 

RETURN[FALSE, OC]}; 

SetCommandString: PUBLIC PROC [s: LONG STRING] = { 

IF command # NIL THEN Heap.systemZone.FREE[@command]; 
command <- s; commandlndex <- 0}; 


-- Initialization Stuff 

GetTime: PROC = { 

tlmeTrys: CARDINAL «- 3; 

time: System.GreenwichMeanTime; 

LTPs: System.Local TimeParameters; 

timeFromServer: BOOLEAN <- TRUE; 
getTimeString: LONG STRING <- NIL: 

[time, LTPs] *- Othel loOps .GetTimeFromTimeServer[ 

! Othelloops.TimeServerError => IF error=noResponse THEN { 

IF (timeTrys «■ timeTrys-l)=0 THEN {timeFromServer «• FALSE; CONTINUE} 

ELSE {IF timeT rys = 2 THEN WriteString["Locating Time Server..."L]; RETRY}} 
ELSE IF error=noCommunicationFaci1ities THEN { 

WriteL ine["not Communication Facilities to find time"L |; 
timeFromServer «- FALSE; CONTINUE} 

ELSE ERROR]; 

IF timeFromServer THEN { 

IF timeTrys#3 THEN WriteLine["success"L]; 

System.SetLocalTimeParameter$[LTPs]; 

OthelloOps.SetProcessorTime[time]; 

RETURN}; 


VolumelnitCommandlmpl.mesa 


23-Jan-87 12:15:45 PST 


WriteLine["failed ArPlease enter time information (type ? for help)"LJ; 
getTimeString *• Heap.systemZone.NEW[StringBody[10]]; 

LTPs *- GetTimeZoneFromUser[@getTimeString ! TryAgain => RETRY]; 
Systera.SetLocalTimeParameter$[LTPs]; 
spacesInStringOK *■ TRUE; 

GetTimeFromUser[@getTimeString ! TryAgain => RETRY]; 
spacesInStringOK «■ FALSE; 

Heap.systemZone.FREE[@getTimeString]}; 

Get!ImeFromUser: PROC [p: LONG POINTER TO LONG STRING] = { 

timePrompt: STRING = "Please Enter the date and 24 hour time in form 
DD-MMM-YY HH:MM:SS 
Time: "L; 

IF Othelloops.IsTimeVal1d[] THEN { 

WriteString["Current time'L]; WriteTime[System.GetGreenwichMeanTime[]]; 

IF ~Yes["Do you wish to change the time?: ”L] THEN RETURN}; 

IF pmil THEN p. length 0; 

DO 

time: System.GreenwichMeanTime; 

GetName[timePrompt, p]; 

time <- PackedTimeFromString[pt, FALSE]: 

IF time=System.gmtEpoch THEN { 

WriteLine["Invalid date/time -- please try again."L]; LOOP}; 

WriteString["Set time to"L]; WriteTime[time]; 

IF Yes["Okay?: "L] THEN { 

OthelloOps.SetProcessorTime[time]; EXIT} 

ELSE LOOP 
ENDLOOP}; 

GetTimeZoneFromUser: PROC [string: LONG POINTER TO LONG STRING] 

RETURNS [1tp: System.LocalTimeParameters] - { 

GetNum: PROC [ 

prompt: STRING, min, max, default: INTEGER] 

RETURNS [ans: INTEGER] = ( 
string. length «- 0; 

String.AppendDecimal[stringt. default]: 

DO 

isNeg: BOOLEAN FALSE; 

WriteString[prompt]; 

WriteChar['[]; IF ans<0 THEN WriteChar['-]; WriteLongNumber[ABS[min]]; 

WriteString[”..”L]; WriteLongNumber[max]; WriteString["]: "L]j 
GetNamefdest; string, signalQuestion: TRUE]; 
ans <- 0; 

FOR 1: CARDINAL IN [0 .. string.length ) DO 

IF i =0 AND string[ i - THEN (IsNeg TRUE: LOOP}; 

IF string[i] NOT IN [ r 0..'9] THEN EXIT; 
ans «- 10*ans + string[i] - '0; 

REPEAT FINISHED => { 

IF isNeg THEN ans *- -ans; IF ans IN [min..max] THEN RETURN}; 

ENDLOOP; 

WriteLine["Bad Number !”L]: 

ENDLOOP}; 

dstSpiel: STRING = M 

The ""First day of DST"" is the day of the year on or before which 
Daylight Savings Time takes effect, where: 

1 January 1 
366 -> December 31. 

(The correspondence between numbers and days is based on a leap 

year. Similarly, '"'Last day of DST"" is the day of the year on or 

before which Daylight Savings Time ends. Note that in any given 
year. Daylight Savings Time actually begins and ends at 2 AM on 
the last Sunday not following the specified date. The system 
makes this adjustment for you automatically. The normal values 
are 

121 (April 30) for the first day of DST 

305 (October 31) for the last day of DST. 

If Daylight Savings Time is not observed locally, both values 
should be set to zero."L; 

ZoneSpiel: STRING = " 

Number of hours between Greenwich and local time. For time 
zones west of Greenwich, the offset is negative; for time zones 
east of Greenwich, the offset is positive. Examples: 

San Francisco -8 hours (Pacific time zone) 

Denver -7 hours (Mountain time zone) 

Chicago -6 hours (Central time zone) 

Boston -0 hours (Eastern time zone)"L; 

n; INTEGER; 

n *• GetNum[pronipt: "Time zone offset from Greenwich "L, min: -12, max; 12, default; -8 
! Question => {WriteLine[ZoneSpiel]; RETRY}]; 

1 tp .di rection *- IF n<0 THEN west ELSE east; ltp.zone *■ ABS[n]; 

1 tp. zoneMinutes *■ GetNum[prompt: "Minute offset "L, min; 0, max: 59. default: 0 
! Question => {Wr1teLine["\rAlmost always zero"L]; RETRY}]; 

ltp.beginDST «- GetNum[prompt: "First day of DST "L, min: 0, max: 366. default: 121 
! Question => {WriteLine[dstSpiel]; RETRY}]; 

Itp.endDST «- GetNum[prompt: "Last day of DST "L, min: 0, max: 366, default: 305 
! Question => (WriteLine[dstSpiel]; RETRY}]}; 

PrintHerald: PROC = { 

copyright: STRING = [100]; 
version: STRING = [10]; 

IF useADM THEN WriteChar['\032]; -- clear screen 
VersionExtras.AppendCopyright[copyright]; 

Version.Append[version]; 

WriteString[copyright]; WriteStr1ng["\n\n"L]; 

WriteString["Othello "L]; WriteString[version]; WriteStr ing[" of "L]; 

WriteTime[Runtime.GetBcdTime[], FALSE, pacific]}; 
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PrlntPIDs: PROC = { 

w: Format.StringProc = (WriteString[sj); 

Wr1teString["Proces$or = "L]; 

Format.HostNumber[proc: w, 

hostNumber: LOOPHOLE[SpecialSystem.GetProcessorID[]], format: hex]; 
WriteString[" = "L]; 

Format.HostNumber[proc: w, 

hostNumber: LOOPHOLE[$pecialSystem.GetProcessorID[]], format: octal ]: 
WriteString["B = "LJ: 

Format.HostNumber[proc: w, hostNumber: 

LOOPHOLE[SpecialSystem.GetProces$orID[]], format: productSoftware]; 
NewLine[]; 

}: 

PrintMemorySlze : PROC = { 

size: LONG CAROINAL «■ ((SpecialSpace.realMemorySize+255)/256)*64; 
WriteString["Memory size = "L]; 

WriteLongNumber[size*2]; 

WriteString["K bytes"L]; 

NewLine[]; 

}; 


<< The following move to proc. Run 
SetCur$or[pointer]; 

PrintHeraldf]; 

PrintPIDs[]; 

PrintMemorySize[]; 

GetTime[];>> 

END. . 


LOG 








T ime 

1 -Oct-81 18:44:29 

By: 

FXH 

T i me 

13- 

Nov-81 

16: 

27: 

44 

By: 

FXH 

T ime 

19- 

Nov-81 

9: 

26: 

07 

By: 

FXH 

T ime 

17- 

Dec-8t 

17: 

52 : 

16 

By: 

CRF 

f ime 

29- 

Dec-81 

14: 

29: 

14 

By; 

CRF 

T ime 

29- 

Dec-81 

14: 

29: 

14 

By: 

FXH 

T ime 

1- 

Feb-82 

16: 

11: 

37 

By: 

CRF 

T ime 

3- 

Feb-82 

15: 

02: 

19 

By: 

CAJ 

T ime 

8- 

Feb-82 

17: 

20: 

50 

By: 

CRF 

T ime 

1- 

Mar-82 

13: 

55: 

31 

By: 

CAJ 

T ime 

20 

-Aug-82 

16 

: 49 

: 26 

By: 

AEF 

T ime 

16 

-Sep-82 

11 

: 47 

: 54 

By: 

AEF 

T ime 

24 

-Sep-82 

17 

: 24 

: 53 

By: 

AEF 

T ime 

30 

-Sep-82 

13 

: 48 

: 48 

By: 

AEF 

T ime 

12 

-Dec-82 

12 

:50 

: 23 

By: 

RXJ 

T i me 


-Jun-86 

12 

: 03 

: 59 

By: 

NFS 


Action: Re-do module, 
add Time Stuff & Proc [D 
Action: 8.0e build 

Make PackedTimeFromString public for 
implementing SetBootFi1eExpirationDate 
Action: 8.Of build -- changed herald. 
Action: 8.0g build -- changed herald. 
Action: 8.Oh build -- changed herald. 
Action: 8.0i build -- changed herald. 
Action: Print processor ID all 3 
ways using Format. 

Action: 8.0j build -- changed herald. 
Action: final 8.0 build -- changed herald 
Action: Change to 9.0b. 

Action: Change to 9.0c. 

Action: Change to 9.0d. 

Action: Change to 9.0. 

Action: 10.0c; remove Storage. 

Adapted for OthelloTool 
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-- Copyright (C) 1983 by Xerox Corporation. All rights reserved. 

-- VolumelnitlmplA.mesa edited by: 

RXJ 2-Dec-83 18:21:20 

RES 17-Oct-83 14:53:35 

NFS 4-Jun-86 14:08:44 

DIRECTORY 

Device USING [PilotDisk, Type], 

DeviceTypes USING [ 

q20Q0, q2010, q2020, q2030, q2040, q2080, salOOO, sal004. sa4000, 
sa4008, t300, t80], 

Environment USING [wordsPerPage], 

File USING [ 

Delete, File, GetAttributes, ID, nullFile. PageNumber, Type, Unknown], 

Heap USING [systemZone], 

Inline USING [BITROTATE], 

OtholloOef$ USING [ 

AbortingCommand, CloseFetch, CommandProcessor, Confirm, GetName, 

IndexTooLarge, LeaderPage, leaderPages, IpVersion, MyNamels, Newline, 

PackedTimeFromString, Question, ReadNumber. RegisterCommandProc, 

SetCommandString, WriteChar, WriteFixedWidthNumber, WriteLine. 

WriteLongNumber, WriteOctal, WriteString, Yes], 

OthelloOps USING [ 

BadSwitches, BootFileType, DecodeSwitches, DeleteTempFile$. GetDriveSize, 

GetNextSubVolume, GetPhysicalVolumeBootFile, GetSwitches, GetVolumeBootFi1e, 
nullSubVolume, SetDebugger, SetDebuggerSuccess. SetExpirationDate, 

SetExpirati onDateSuecess, SetGetSwitchesSuecess, SetPhysicalVolumeBootFile, 

SetSwitches, SubVolume, VoidPhysicaIVolumeBootFile, VoidVolumeBootFile], 

OthelloToolDefs USING [CloseVolume], 

PhysicalVolume USING [ 

AssertPilotVolume, DamageStatus, Error, GetAttributes. GetHandle, GetNext, 

GetNextBadPage, GetNextDrive, GetNextLogicalVolume, Handle. ID, 

InterpretHandle, MarkPageBad, maxNameLength, noProblems. nullBadPage, 
nulIDevicelndex, nullID, Offline, PageNumber, RepairType. Scavenge, 

ScavengerStatus], 

Process USING [MsecToTIcks], 

Runtime USING [IsBound], 

Scavenger USING [ 

BootFileType, Error, FileEntry, Header, Problem, RepairType, Scavenge], 

Space USING [Copyln, Map, ScratchMap, Unmap], 

SpecialVolume USING [OpenVolume], 

String USING [ 

AppendCharAndGrow, AppendLongNumber, AppendStrlng, CopyToNewString, Equivalent, 

Length, Replace], 

System USING [ 

defaultSwitches, GetLocalTimeParameters, gmtEpoch, GreenwichMeanTime, 

PowerOff. Switches], 

TemporaryBooting USING [BootButton, BootFromVolume]. 

Volume USING [ 

Erase, GetAttributes, GetLabelString, GetType, ID, 

NeedsScavenging, NotOnline, nullID, Open, systemID, Type], 

VolumeVersion USING [Examine]; 

VolumelnitlmplA: PROGRAM 
IMPORTS 

File, Heap, Inline, OthelloDefs, OthelloOps, OthelloToolDefs, PhysicalVolume, Process, Runtime, 
Scavenger, Space, SpecialVolume. System, String, TemporaryBooting, Volume, 

VolumeVersion 
EXPORTS OthelloDefs 
SHARES File - 

BEGIN OPEN OthelloOps, OthelloDefs: 


commandProcessor: CommandProcessor <- [CommonCommands] 

CommonCommands: PROC [index: CARDINAL] = { 

SELECT index FROM 
0 => BootBoot[]; 

1 => DeleteBootFi1es[]; 

2 => DeleteTempFilesUser[]; 

3 => DescribePhysicalVolumes[]: 

4 => Erase[]; 

5 => ListBadPages[]; 

6 => ListBootFi1es[]; 

7 => ListDrives[] : 

8 => ListLogicalVolumes[] ; 

9 => ListPhysicalVolumes[]; 

10 => MakeBad[]; 

11 => Off1ine[]; 

12 => Online[]; 

13 => PowerOff[]; 

-> PVScavenge[]: 

|T5>>Quit[]; 
l=> Scavenged: 

=> SetBootFileSwitchesf]; 

=> SetDebuggerUser[]; 

JA => SetExpirationDateUser[]; 

/2C/=> SetPvBoot[]; 

=> WizardMode[ ] : 

ENDCASE => IndexTooLarge}; 


logicalVolumeTypeString: ARRAY Volume.Type OF LONG STRING 
"normal", "debugger", "debuggerOebugger", "nonPilot"]: 


inputDriveString: LONG STRING *• NIL 
inputLogicalString: LONG STRING *■ NIL 
debuggerLogicalStr ing : LONG STRING *■ NIL 
inputPhysString: LONG STRING - NIL 
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LONG STRING <• NIL 
LONG STRING «■ NIL 
LONG STRING <- NIL 


switches: 

1vTypeString: 
exp irat ionstring: 

maxNamelength : CARDINAL = PhysicalVolume .maxNameLength ; 

BootBoot: PROC = 

BEGIN 

1vID: Volume.ID; 
ts: System.Switches; 

MyNameIs[ 

myNamels: "Boot"L, myHelpIs: "Boot From Logical Volume"L]; 
lvID «- GetLvIDFromllser[] .IvID; 

GetSetBootFileSw1tches[get, lvID 
! Volume.NeedsScavenging, File.Unknown => { 

WriteLine["(can't get default switches)"Lj; 

CONTINUE}; 

AbortingCommand => { 

WriteLine[reason]; 

WriteLine["(can't get default switches)"L]; 

CONTINUE}]; 

DO 

GetName["switches: "L, ©switches, echo. TRUE 
! Question => { 

WriteLine[ 

"See Pilot Users Handbook for list of valid switches.”L]: 

RESUME}]; 

ts «- DecodeSwitches[switches 

! BadSwitches -> {WriteLine["bad switches"L]; LOOP}]; 

EXIT; 

ENDLOOP; 

IF Runtime.IsBound[LOOPHOLE[CloseFetch]] THEN CloseFetch[]; 
TemporaryBooting.BootFromVolume[lvID, ts]; 

END; 

DeleteBootFiles: PROC = 

BEGIN 

lvID: Volume.ID; 
pvID; PhysicalVolume.ID; 

MyNameIS[ 

myNamels: "Delete Boot Files"L, 

myHelpIs: "Delete all boot files from volume"L]; 

[pvID; pvID, lvID: lvID] «- GetLvIDFromUser[]; 

IF lvID = Volume.systemID THEN { 

WriteLine["Can not delete boot file of current system volume."LJ; 

RETURN;}; 

FOR t; BootFileType IN [hardMicrocode..pilot] DO 
file; File.File = GetVolumeBootFi1e[1vID, tj.file; 

IF file = File.nullFile THEN LOOP; 

Volume.Open[fi1e.vo1umelD]; 

BEGIN ENABLE File.Unknown => CONTINUE; 

File.Delete[fi1e]; 

END; 

VoidVolumeBootFile[lvID, t]; 

IF GetPhysicalVo 1umeBootFilefpvID. tj.file = file THEN 
VoidPhysicalVo 1umeBootFile[pvID, t]; 

OthelloToolDefs.CloseVolume[1vID]; 

ENDLOOP; 

END; 

DeleteTempFilesUser: PROC - { 
lv: Volume.ID; 

MyNameIs[ 

myNamels: "Delete Temporary Files"L, 
myHelpIs: "Delete Temporary Files"L]; 
lv «- GetLvIDFromUser[] . 1 vID; 

IF lv = Volume.systemID THEN { 

WriteLine["Can not delete temp files on current system volume."!-]; 
RETURN;}; 

DeleteTempfiles[lv]}; 

DescribePhysIcalVolumes; PROC = 

BEGIN 

pvID: PhysicalVolume . ID +• PhysicalVolume . null ID; 

pvFound: BOOLEAN <- FALSE; 

MyNameIs[ 

myNamels: "Describe Physical Volumes"L, 
myHelpIs: "Describe online physical volumes"L]; 

DO 

h: PhysicalVolume.Handle; 

s: STRING «• [maxNameLength]; 

sV: SubVolume *■ nullSubVolume ; 

sVFound: BOOLEAN <- FALSE; 

IF (pvID «• PhysicalVoltime ,GetNext[pvID]) = PhysicalVolume. nul 1 ID THEN EXIT 
pvFound «- TRUE; 

h «- PhysicalVolume.GetAttributes[pvID. s]. instance; 

WriteString["Phy$lcaI Volume "L]; 

WriteString[s]; WriteString[" on drive "LJ; 

WriteString[GetDriveStringName[h]]; 

WriteString[" ("LJ; 

WriteStr1ng[ 

SELECT GetDriveType[h] FROM 

DeviceTypes.sal004, DeviceTypes.salOOO => "Shugart 1000"L, 

DeviceTypes.sa4000, DeviceTypes.sa4008 -> "Shugart 4000"L. 

DeviceTypes.q2000. DeviceTypes.q2010, DeviceTypes .q2020. 


VolumelnitlmplA.mesa 


23-Jan-87 12:09:18 PST 





=> "Quantum 2000"L, 


DeviceTypes.q2030, OeviceTypes.q2040, OeviceTypes.q2080 
OeviceTypes.t80 => "T80"L, 

DeviceTypes . t300 => ,, T300"L, 

ENDCASE => "unknown type"L]; 

DO 

needsScavenging: BOOLEAN «- FALSE; 
freePages, volumeSIze; LONG CARDINAL; 
sV *■ GetNextSubVolume[pvID, sV]; 

IF SV = nullSubVolume THEN EXIT; 

IF ~sVFound THEN WriteL1ne[") contains:"L]; 
sVFound *■ TRUE; 

WriteString["Volume ”L]; 

[volumeSize: volumeSize, f reePageCount: freePages] «- Volume.GetAttributes[sV.1vID 
! Volume.NeedsScavenging => { 
needsScavenging «- TRUE; 
volumeSize <* 0; -- don't really know 
CONTINUE }]; 

IF volumeSize ft sV.subVolumeSize AND volumeSize ft 0 THEN 
WriteString["p1ece ”L]; 

GetLogicalVolumeName[sV.lvID, s]; 

WriteString[s]; WriteString[" (type = ”L]; 

WriteString[GetLogicalVolumeTypeName[sV.1vID]]; WriteString[") ”L]; 

IF volumeSize = $V.sgbVolumeSize THEN { 

WriteLongNumber[freePages]; WriteString[" of "L]; 

WriteLongNumber[volumeSize]; WriteString[" pages free"L]} 

ELSE [WriteLongNumber[sV.subVolumeSize]: WriteString[" pages"L]}; 

IF needsScavenging THEN WriteString[" *** Needs Scavenging ***"L]; 

NewLine[]; 

WriteString[" starting at physical address ”L]; 

WriteLongNumber[sV.firstPVPageNumber]; 

NewLine[]; 

IF ~needsScavenging THEN ShowBootFiles[pvID, sV.lvID]: 

ENDLOOP; 

IF ~sVFound THEN WriteL1ne[") no subvolumes'’L]; 

ENDLOOP; 

IF ~pvFound THEN WriteLine["No physical Volumes found"L]; 

END; 

Erase: PROC - { 

1vID: Volume.ID; 
pvID; PhysicalVolume.ID; 

MyNameIs[ 

myNamels: "Erase"L. myHelpIs: "Erase Logical Volume"L]; 

[pvID: pvID, lvID; lvID] *■ GetLvIDFromUser[]; 

IF lvID = Volume.systemID THEN { 

Wr1teLine["Can not erase current system volume."L]; 

RETURN;}; 

Confirm[]; 

Othel loToolDefs.CloseVolunie[lvID] ; 

SELECT VoluiiieVersion .Examine[lvID] FROM 
otherVersion => 

IF Yes["That volume is not in the current format. Do you want to convert it? "L] 
THEN Confirmftwice] 

ELSE RETURN: 

ENDCASE; 

WriteString["Erasing..."L]; 

Volume.Erase[lvID]; 

FOR t: BootFlIeType IN [hardMIcrocode..pi lot] DO 

IF GetPhysicaIVolumeBootFile[pvID, t].file.volumelD = lvID THEN 
VoidPhysicalVolumeBootFile[pvID. t]; 

ENDLOOP: 

WriteLine["comp Iete"L]}; 

Lis t.BadPages: PROC = 

BEGIN 

id; PhysicalVolume.ID; 

page: PhysicalVolume.PageNumber «- Physical Vol ume . nul 1 BadPage ; 
badSpots: BOOLEAN <- FALSE; 
col : CARDINAL «• 0 ; 

MyNameIs[ 

myNamels: "List Bad Pages"L, 

myHelpIs; "List known bad pages on Pilot volume"L]: 
id *- GetPvIDFromUserf] . id; 

WHILE (page «■ Physi cal Volume .GetNextBadPage[ id , page]) ff 
PhysicalVolume.nuliBadPage DO 
IF col = 6 THEN BEGIN NewLine[]; col *■ 0; END; 

WriteFixedWidthNumber[page. 11]; 
col col + 1; badSpots *• TRUE; 

ENDLOOP; 

WriteLine[IF badSpots THEN NIL ELSE "No known bad spots"L]: 

END; 

LlstBootFIles: PROC = 

BEGIN 

lvID: Volume.ID; 
pvID; PhysicalVolume.ID; 

MyNameIs[ 

myNamels: "List Boot Files"L. 

myHelpIs; "List boot files on Pilot volume"L]; 

[pvID: pvID, lvID: lvID] «• GetLvIDFromUser[]: 

ShowBootF11es[pvID, lvID]; 

END; 

ListDrlves: PROC = { 

index: CARDINAL «- Phys i cal Vol ume . nul 1 Devi cel ndex ; 
first: BOOLEAN *• TRUE; 

MyNameIs[myNameIs: "List Drives"L. myHelpIs: "List Drives“L]; 
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00 

index <- PhysicalVolume.GetNextDrive[index]; 

IF index = PhysicalVolume.nulIDevicelndex THEN EXIT; 

IF ~first THEN WriteString[", "L]; 
first «- FALSE; 

WriteString[GetDriveStringName[PhysicalVolume.GetHandle[index]]]; 
ENDLOOP; 

NewLine[]}; 

ListLogicalVolumes: PROC = 

BEGIN 

first: BOOLEAN «- TRUE; 

pID: PhysicalVolume . ID *■ Physical Volume . nul 1 ID; 

MyNameIs[ 

myNamels: "List Logical Volumes'^. myHelpIs: "List Logical Volumes"!-]: 

00 

sV: SubVolume *■ nul 1 SubVolume: 
pID «■ PhysicalVolume .GetNext[pID]; 

IF pIO = PhysicalVolume.nullIO THEN EXIT; 

00 

s: STRING *• [maxNameLength]; 
sV «• GetNextSubVolume[pID, sV]; 

IF sV = nul1SubVolume THEN EXIT; 

IF sV.firstLVPageNumber ¥ 0 THEN LOOP; 

IF -first THEN Wr1teString[". "L]; 

WriteString[GetDriveStringName[ 

Physical Volume.GetAttributes[pID].instance]]; 

WriteChar[':]; 

GetLogicalVo1umeName[sV.1 vID, s]; 

WriteString[s]; 
f i rst «- FALSE ; 

ENDLOOP: 

ENDLOOP; 

Wr1teLine[IF first THEN "No logical volumes found"!. ELSE NIL]; 

END: 

ListPhysicalVolumes: PROC = 

BEGIN 

s: STRING = [maxNameLength]; 

driveString: LONG STRING; 

first; BOOLEAN «- TRUE; 

pID; Physi cal Volume. 10 +• PhysicalVolume. nul 1 ID; 

MyNameIs[ 

myNamels: "List Physical Volutnes"L, 
myHelpIs: "List Physical Volumes"L]; 

00 

pID «- PhysicalVolume .GetNext[pID] ; 

IF pID = PhysicalVolume.nullID THEN EXIT; 
driveString *■ GetDriveStringName[ 

PhysicalVolume.GetAttributesfpID. s].instance]; 

IF -first THEN WriteString[". "L]; 

WriteString[driveString]; 

WriteChar[':]; 

WriteString[s]; 
first <- FALSE; 

ENDLOOP; 

WriteLine[IF -first THEN NIL ELSE "No physical volumes found"L]; 

END; 

MakeBad: PROC = 

BEGIN 

h: PhysicalVolume.Handle; 

id: PhysicalVolume.ID; 

page: PhysicalVolume.PageNumber; 

IF -Wizard[] THEN RETURN; 

MyName Is[ 

myNamels; "Make Page Bad"L, 

myHelpIs: "Enter page into bad page table"L]; 

[id, h] <- GetPvIDFromUser[]: 

page «- ReadNumber["Decimal Page Number: "L, 0, GetDriveSize[h] - l ]; 

PhysicalVolume.MarkPageBad[id, page]: 

WriteLine["Consider scavenging some logical volumes."LJ; 

END; 

Offline: PROC = { 

MyNameIs[ 

myNamels: "Offline"L, myHelpIs: "Bring physical volume offline"L]; 
PhysicalVolume.Offline[GetPvIDFromU$er[].id]}: 

Online: PROC = { 

pvID: PhysicalVolume.ID; 

MyNameIs[ 

myNamels: ,, Online"L. myHelpIs: "Bring drive online"L]; 
pvID PhysicalVolume.AssertPilotVolume[GetDriveFromUser[] ! 

PhysicalVolume,Error => IF error = alreadyAsserted THEN CONTINUE]; 

-- (maybe) update time parameters on disk 
[] <- System.GetLocalTiineParametersfpvID]}; 

PowerOff: PROC = { 

MyNameIs[ 

myNamels: "Power Off", myHelpIs: "Execute System.PowerOff"L]; 
Confirm[]; CloseFetch[]; System.PowerOff[]}; 

PVScavenge: PROC = 

BEGIN OPEN PV: PhysicalVolume; 
convert: BOOLEAN <- FALSE; 
s: PV.ScavengerStatus; 
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h: PV.Handle: 

repair: PV.RepairType: 
p; PV. ID «- PV.nullID; 

PrintDamageStatus: PROC [s: STRING, d: PV.DamageStatus] = { 
IF d=okay THEN RETURN; 

WriteString[s]: 

WriteLine[IF d=damaged THEN " damaged"L ELSE " lost"L]}; 


MyNameIs[ 

myNamels: "Physical Volume Scavenge''L, 
myHelpIs: "Scavenge physical volume"L]; 
h *• GetDriveFromUser[]; 
repair <■ 

IF ~Ye$["Repair? "L] THEN checkOnly 

ELSE IF Wizard[] AND Yes["Ri$ky repair? "L] THEN riskyRepair ELSE safeRepair; 

Confirm[]; 

DO 

IF (p«-PhysicalVolume.GetNext[p]) = Physical Volume .nul 1 ID THEN EXIT: 

IF h = PhysicalVolume.GetAttributes[p].instance THEN { 

Physica1 Volume.Offl1ne[p]; EXIT}; 

ENDLOOP; 

BEGIN ENABLE PhysicalVolume.Error => 

IF error = needsConversion AND -convert THEN 

IF (convert * Yes["That volume is not in the current format. Do you want to convert it? "L]) 
THEN {Confirm[]; RETRY} 

ELSE AbortingCommand["Volume cannot be scavenged"L]; 

WriteString["Scavenging..."LJ : 
s «- PV.Scavenge[h, repair, convert]; 

WriteLine["Complete"L]; 

END; -- ENABLE 

IF s = PV. noProblems THEN (WriteLine["No problems tie tected"L]; RETURN}; 

WriteString["Damage detected: "L]: 

IF s.internalStructures # okay THEN { 

WriteStringf"Internal structures "L]; 

WriteLinef 

IF s.internalStructures=damaged THEN 
IF repair=safeRepalr THEN "damaged 
ELSE "damaged"L 
ELSE "repaired"L]}; 

PrintDamageStatus["Bad page lisf'L. 

PrintDamageStatus["Boot fi1e"L , 

PrintDamageStatus["Germ ,, L, 

PrintDamageStatus["Pilot microcode"L, 

PrintDamageStatus["Diagnostic microcode"L, s.hardMicrocode]; 

END; 


contact hardware support for risky repair"L 


s.badPageList] ; 
s.bootF ile]: 
s.germ]; 

softMicrocode]; 


Quit: PROC = { 

MyNameI$[ 

myNamels: "Quit"L, myHelpIs: "Push the boot button"L]; 
Confirm[]; CloseFetch[]; TemporaryBooting.BootButton[]}: 


Scavenge: PROC = { 

convert: BOOLEAN <- FALSE; 

1vID: Volume.ID; 

logFile: File.File; 

logPage: F i 1 e . PageNumber «- 0; 

logWd: CARDINAL «* Environment.wordsPerPage ; 

buffer: LONG POINTER TO ARRAY [0..Environment.wordsPerPage) 


OF UNSPECIFIED <- NIL; 


GetWdS: PROC [p: POINTER, c: CARDINAL] = { 

WHILE c#0 DO 

IF 1ogWd=Environment.wordsPerPage THEN { 

[] «- Space .CopyIn[buf fer, [logFile, logPage. 1]]; 
logPage «- logPage + 1: logWd *■ 0}; 
pt «■ bufferf logWd] ; 
p p+i; c «• c-1: logWd *■ logWd + l; 

ENDLOOP}; 

DisplayScavLog: PROC = { 

fileCount: LONG CARDINAL; problems: BOOLEAN «■ FALSE; 

BEGIN 

hd: Scavenger.Header; 

GetWds[@hd, SIZE[Scavenger.Header]]; 

WriteString["volume"L]; IF ~hd.repaired THEN WriteString[" not"L]; 
WriteStringf" repaired, log file"L]; 

IF hd.incomplete THEN WriteString[" not"L]; WriteLine[" complete "Lj; 

WriteLongNumber[f i 1 eCount <- hd . numberOfF i 1 es ]; 

WriteLine[" files on volume"L]; 

END; 

WHILE fileCount#0 00 

OpenID: TYPE = ARRAY [0..SIZE[Fi1e.ID]) OF CARDINAL; 
fe: Scavenger.FileEntry; 

GetWds[@fe, SIZE[Scavenger.FileEntry]]; 

THROUGH [0 . . fe.numberOfProblems) DO 
fp: Scavenger.Problem; 

GetWds[@fp, SIZE[Scavenger.Problem]]; 

WriteChar['[]; 

FOR i: CARDINAL IN [0..SIZE[File.ID] 1) DO 
WriteOctal[LOOPHOLEffe.fi1e, OpenID][i]]; WriteString[", ’L] ENDLOOP; 
WriteOctal[LOOPHOLE[fe.file, OpenID][SIZE[File.IDJ-1]]; 

WriteString["] type = "L]; 

BEGIN ENABLE File.Unknown => GOTO noType; 

f: File.Type - File.GetAttributes[[fe.file, lvID]].type: 

WriteLongNumber[LONG[LOOPHOLE[f, CARDINAL]]]; 

EXITS noType => WriteString["unknown"L]; 

END; 

WriteString["; "L]; 

WITH fp SELECT FROM 
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unreadable => { 

WriteString["unreadab1e"L]; 

WriteString[" pages [”L]; WriteLongNumberffirst]; 

Wr i teSt ring [" . . "!_] ; WriteLongNumber[f i rst+count] ; WriteLine[")"L]}; 
missing => { 

WriteString["missing"L]; 

Wr1teString[” pages ["L]; WriteLongNumber[first]; 

WriteString[".."L]; WriteLongNumber[first+count]; WriteLine[")"L]}; 
duplicate => { 

WriteString["dup1icate"L]; WriteLine[" page found"L]}: 
orphan => { 

WriteString["orphan"L]; WriteLine[" page found"L]}; 

ENDCASE => WriteLine["unknown problem"L]: 
problems + TRUE; 

ENDLOOP; 

fileCount + fileCount-l; 

ENDLOOP; 

WriteLine[IF -problems THEM "No problems found"L ELSE NIL]}; 

MyNamelsf 

myNamels: "Scavenge"L, myHelpIs: "Scavenge Logical Volume"LJ; 
lvID + GetLvIDFromUser[].1vID; 

IF 1vID = Volume.systemID THEN { 

WriteLine["Can not scavenge current system volume."L]; 

RETURN;}; 

Confirm[]; 

OthelloToolDefs.CloseVolume[lvID ! ANY => CONTINUE]; 

BEGIN ENABLE Scavenger.Error => 

IF error = needsConversion AND -convert THEN 

IF (convert + Yes["That volume is not in the current format. Do you want to convert it? "L]) 
THEN {Confirm[twice]; RETRY} 

ELSE AbortingCommand["Volume cannot be scavenged"L]; 

WriteString["Scavenging...”L]; 

logFile + Scavenger.Scavenge[1vID. lvID, safeRepair. convert]; 

WriteLine["Complete"L]; 

END; -- ENABLE 

SpecialVolume.OpenVolume[lvID. read]; 
buffer + Space.ScratchMap[1]; 

OisplayScavLog[ 

! UNWIND => {[] + Space.Unmapfbuffer]; OthelloToolDefs.CloseVolume[1vID]}]; 

[] + Space.Unmap[buffer]; OthelloToolDefs.CloseVolume[lvID]}; 

SetBootFileSwitches; PROC = 

BEGIN 

ts: System.Switches; 

lvID: Volume.ID; 

MyNameIs[ 

myNamels: "Set Boot File Default Switches'^, 
myHelpIs: "Set default switches for boot file on volume"L]; 
lvID + GetLvIDFromUser[].1vID; 

GetSetBootFileSwitches[get, lvID]; -- volume.needsScav (caught higher up) 

DO 

GetName["switches: "L, @switche$. echo. TRUE 
! Question => (WriteLine[ 

"See Pilot Users Handbook for list of valid switches."L]; 

RESUME}]; 

ts + DecodeSwitches[switches 

! BadSwitches => (Wr1teLine["bad switches"L]; LOOP}]: 

EXIT; 

ENDLOOP; 

Confirm[]; 

GetSetBootFiieSwitches[set, lvID, ts]; 

END; 

SetDebuggerUser; PROC = 


BEGIN 


file: 

File.File: 

firstPage: 

File.PageNumber; 

lvID: 

Volume.ID; 

dLvID: 

Volume.ID; 

dH: 

PhysicalVolume.Handle 

dT: 

Dev ice.Type: 

dO: 

CARDINAL; 

outcome: 

SetDebuggerSuccess: 

MyNamels[ 



myNamels: "Set Debugger Pointers"L, 
myHelpIs: "Set up pointers to debugger for volume"L]; 
lvID + GetLvIDFromUser["for debuggee Logical Volume: "LJ.lvID: 

[file, firstPage] + GetVolumeBootFile[lvID. pilot]; 

IF file = File.nullFIle THEN 

AbortingCommand["No boot file found."L]; 

[, dLvID, dH] + GetLvIDFromUser["for debugger Logical Volume: "L, TRUE]; 
IF dLvID=Volume.nul1ID THEN Wr1teLine["(C1ear existing pointers)"L] 

ELSE (dT + GetDriveType[dH]; dO + GetDriveNumber[dH]}; 

Confirm[] ; 

Volume.Open[lvID]; 
outcome + SetDebugger[ 

debuggeeFile: file, debuggeeFirstPage: firstPage, debugger: dLvID, 
debuggerType: dT, debuggerOrdinal: dO]; 

OthelloToolDefs.CloseVolume[lvID]; 

WriteSetDebuggerSuccess[outcome]; 

END; 

SetExpirationDateUser: PROC = 

BEGIN 

file: File.File; 
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firstPage: File.PageNumber; 

time: System.GreenwlchMeanTIme; 

IvID: Volume.ID; 

outcome: SetExpirationDateSuccess; 

MyNameI$[ 

myNamels: "Set Hardware Clock Upper Limit"L, 

myHelpIs: "Set last believable hardware clock date for boot file on logical volume"!.]; 
IvID <- GetLvIDFromUser[] . 1 vID; 

[file, firstPage] *■ GetVo1umeBootFile[lvID. pilot]; 

IF file = Fi1e.nullFi1e THEM 
AbortingCommand[’’No boot file found."L]; 

DC) 

GetName["Date (DD-MMM-YY): "L, @expirationString |; 

IF expirationstring.length=0 THEN { 

WriteLine["(setting no upper limit on hardware clock)"L]; 
time «- System.gmtEpoch ; 

EXIT) 

ELSE { 

time *■ PackedTimeFromString[s: expi rationstring. justDate; TRUE]; 

IF time=System.gmtEpoch THEN WriteLine["invalid date"L] 

ELSE EXIT}; 

ENDLOOP; 

Confirm[]; 

Volume.Open[lvID]; 

outcome «- SetExpirationDate[f ile . firstPage, time]; 

Othel loToolDef s .CloseVolunte[l vID] ; 

WrlteSetDebuggerSuccess[outcome]; 

END; 

f SetPvBoot; PROC - 
BEGIN 

IvID: Volume.ID: 

set: ARRAY BootFi 1 eType[hardMicrocode . . p i 1 ot] OF BOOLEAN «- ALL[FALSE]; 
found, changed: BOOLEAN «- FALSE; 

Smash: PROC [s; STRING, t: BootF11eType] * { 

IF GetVolumeBootFile[lvID, t].file = File . nu11F i 1e THEN RETURN; 
found TRUE; 

WriteString["Set physical volume "L]; 

WriteString[s]; 

IF (set[t] *■ Yes[" from this logical volume? "L]) THEN changed *- TRUE}; 

MyNameIs[ 

myNamels: "Set Physical Volume Boot Files"L, 
myHelpIs: "Set Physical Volume Boot Files"L]; 

IvID «• GetLvIDFromUser[] . 1 vID; 

Smash["boot file"L, pilot]; 

Smash["pilot microcode"L, softMicrocode]; 

Smash["germ file"L, germ]; 

Smash["diagnostic microcade"L, hardMicrocode]; 

IF -found THEN AbortingCoinmand["Logical volume has null boot files"L]: 

IF -changed THEN RETURN; 

Conf i mi[]; 

SpecialVolume.OpenVolume[IvID, read]; 

FOR t: BootFileType IN [hardMicrocode..pilot] DO 
IF set[t] THEN { 
file: File.File: 
firstPage: File.PageNumber; 

[file, firstPage] «- GetVo lumeBootF i le[ I vID. t]: 

SetPhysicalVolumeBootF11e[file, t, firstPage]}: 

ENDLOOP; 

OthelloToolDefs.CloseVolume[lvID]; 

END; 


ShowBootFi1es: PROC [pv: PhysicalVolume.ID, Iv: Volume.ID] - { 
bootNames: ARRAY BootFi 1 eType[hardMicrocode. .pilot] OF STRING <- [ 
hardMicrocode: "Diagnostic microcode"L, 
softMicrocode: "Pilot microcode"L. 
germ: "Germ"L, 
pilot: "Pilot bootfile"L]; 

SpecialVolume.OpenVolume[lv, read ! Volume.NeedsScavenging -> GOTO scavenge]: 

FOR t: BootFileType IN BootFileType[hardMicrocode..pi lot] DO 
ENABLE UNWIND => GthelloToolDefs.CloseVolume[1v]; 
file: File.File; 
firstPage: Fi1e.PageNumber; 

[file: file, firstPage: firstPage] *■ GetVolumeBootFile[l v, t]: 

IF file = File.nullFile THEN LOOP; 

WrlteStringf" "L]; 

IF GetPhysicalVolumeBootFile[pv, tj.file - file THEN 
WriteString["(PV) "L]; 

WriteStr1ng[bootNames[t]]; 

WriteString["; "L]; 

IF firstPage = Othel1oOefs.1eaderPages THEN ShowLeaderNote[fi1e] 

ELSE WriteLine["(no information aval 1 able )"L]; 

ENDLOOP; 

OthelloToolDefs.CloseVolume[lv]; 

EXITS 

scavenge => NULL}; 

ShowLeaderNote: PROC [file: File.File] = { 

Ip: LONG POINTER TO OthelloOefs.LeaderPage; 

lp «■ Space.Map[window:[file, 0, OthelloDefs . leaderPages] , access: readonly] . po inter: 
IF lp.version - Othel1oDefs.lpVersion THEN 

FOR i: CARDINAL IN [0..lp.length) DO WriteChar[1p.note[1]] ENDLOOP 
ELSE WriteString["(no information available)"L]; 

NewLine[]; 
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[] «■ Space.Unmap[lp]} ; 

WizardMode: PROC = { 

password: LONG STRING «■ NIL; 

IF wizardMode THEN RETURN: 

MyNameIs[ 

myNatftels: “Wizard Mode"L, myHelpIs: "Enable special commands”L]; 
GetName["Password: "L, ^password, stars]: 

IF Hash[password] = wizardPassword THEN (wizardMode TRUE; WriteLine[" ok"L]} 
ELSE WriteL1ne[" incorrect password"L]}; 

- Wizard Supporting Procedures 

wizardMode: BOOLEAN «- Process.MsecToTicks[2000] # 39; --FALSE for DLion only. 
wizardPassword: CARDINAL = 18939: 

Hash: PROCEDURE [s: LONG STRING] RETURNS [h: CARDINAL] = 

BEGIN 
h <- 17777: 

FOR 1: CARDINAL IN [0..String.Lengthfs]) DO 
c: CHARACTER: 

IF (c <- s[i ]) IN [ ' A. . ’Z] THEN c «- c + ( ' a-*A); 
h «- Inline.BITROTATE[h. 1] + (c-OC); 

ENDLOOP; 

END; 

Wizard: PUBLIC PROC RETURNS [BOOLEAN] = (RETURN[wizardMode]}: 

Volume Init Supporting Procedures 
unknown: LONG STRING = "Unknown": 

GetSetBootFi1eSwitches: PROC [ 

getSet: (get, set). ivID: Volume.ID, 

ts: System.Switches *• System.defaultSwitches] = [ 

outcome: SetGetSwitchesSuccess; 

file: File.File: 

firstPage: FI 1e.PageNumber; 

Heap.systemZone.FREE[@switches]; 

IF getSet=get THEN SpecialVolume.OpenVolume[lvID, read] 

ELSE Volume.Open[lvID]; 

[file. firstPage] <- GetVolumeBootFile[l vID, pilot]; 

IF file = Fi le . nul 1 Fi le THEN AbortingCommand[ "No boot file found."!,]; 

IF getSet=get THEN [outcome, ts] «- GetSwitches[f ile, firstPage] 

ELSE outcome «- SetSwitches[file. firstPage. ts]: 

OthelloToolDefs.CloseVolume[lvID]: 

WriteSetDebuggerSuccess[outcome]; 

IF getSet-set THEN RETURN; 

FOR c: CHARACTER IN [OC..377C] DO 
IF ts[c] = up THEN LOOP; 

SELECT c FROM 

' W. ", ,M => NULL; 

IN [’a..'z], IN ['A..*Z]. IN ( 1 . . ’?] => { 

String.AppendCharAndGrow[@switches. c, Heap.systemZone]: LOOP); 

ENDCASE => NULL: 

String.AppendCharAndGrow[@switches, ’\\, Heap.systemZone]: 

String.AppendCharAndGrow[@switches. (c-0C)/64 + ’0, Heap.systemZone]; 

String.AppendCharAndGrow[@switches, ((c-0C)/8 MOD 8) + ’0, Heap.systemZone]; 
String .AppendCharAndGrow[@switches . ((c-OC) MOD 8) +• '0, Heap . systemZone J; 
ENDLOOP}; 

WriteSetDebuggerSuccess: PROC [outcome: SetDebuggerSuccess] = { 

SELECT outcome FROM 
success => NULL; 

nulIBootFile, cantWriteBootFile, notlnltialBootFile => 

AbortingCommand["Boot file broken."L]; 
cantFindStartListHeader, startListHeaderHasBadVersion => 

AbortingCommand["file built by incompatible version of StartPilot"L]: 
noDebugger => AbortingCommand["No debugger installed."L]; 

ENDCASE => ERROR}; 

GetDriveFromUser: PUBLIC PROC RETURNS [h: Physical Volume.Handle] = { 

DO 

index: CARDINAL «- PhysicalVolume . nul IDeviceIndex ; 

GetName[ 

"Drive Name: "L, QinputDriveString, echo. TRUE 
! Question => [ListDrives[]; RESUME}]; 

IF inputDriveString[inputDriveString.length - 1] = ’: THEN 
inputDriveString. length *• InputDriveString. length 1; 

DO 

Index <- Phys ical Volume .GetNextDrive[ i ndex] ; 

IF Index = PhysicalVolume.nulIDeviceIndex THEN EXIT: 
h «- Phys ical Volume .GetHandle[ index]: 

IF String.EquivaIentfGetDrlveStringName[h], inputDriveString] THEN RETURN; 
ENDLOOP; 

WriteLine["0r1 ve not foundf’L] 

ENDLOOP}; 

GetDriveNumber: PUBLIC PROC [h: PhysicalVolume.Handle] RETURNS [CARDINAL] = { 
RETURN[PhysicalVolume.InterpretHandle[h].index]}; 

GetDriveStringName: PROC [h: PhysicalVolume.Handle] RETURNS [s: LONG STRING] = 
BEGIN 

S «- SELECT TRUE FROM 

-- damn compiler won't allow t IN Device.PilotDisk 
LOOPHOLE[GetDriveType[h]. CARDINAL] IN Device.Pi IotDisk 
-> "Rd?". 

ENDCASE "UnknownType?": 
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s[s. length - 1] <- GetDriveNumber[h] + '0; 

END; 

GetDriveType: PUBLIC PROC [h: PhysicalVolume.Handle] RETURNS [Device.Type] = { 
RE.TURN[Phy si cal Volume . InterpretHandle[h]. type]} ; 

GetL.ogicalVolumeName: PROC [vid: Volume.ID, s: STRING] = [ 
s«length <- 0; 

Volume.GetLabelString[vid, s ! Volume.NeedsScavenging -> GOTO bad]; 

EXITS bad => [ 

IDRep: TYPE = RECORD [p; ARRAY [0..3) OF CAROINAL, n: LONG CARDINAL]; 

String.AppendString[s, "NeedsScavenging"L]; 

String.AppendLongNumber[s, LOOPHOLE[vid, IDRep].n, 8]}}; 

GetLogicalVolumeTypeName: PROC [vid; Volume.ID] RETURNS [LONG STRING] = ( 
RETURN[logicalVolumeTypeString[Volume.GetType[vid ! ANY => GOTO signal]]]; 

EXITS signal => RETURN[unknown]}; 

-- Accept string of Form LogicalVolumeName OR 
Drive:Logical VolumeName 
GetLvIDFromUser: PUBLIC PROC [ 
prompt: LONG STRING <- NIL. 
calledFromSetDebuggerPtrs: BOOLEAN *- FALSE] 

RETURNS [ 

pvID: PhysicalVolume.ID, lvID: Volume.ID, 
drive: PhysicalVolume.Handle] - 
BEGIN 

IF prompt = NIL THEN prompt *■ "Logical Volume Name: "L: 

DO 

ptmpID: PhysicalVolume . TD *■ PhysicalVolume.nul11D; 

inputstring: LONG STRING; 
matches: CARDINAL «- 0; 

GetName[ 

prompt: prompt, how; echo, signalQuestion: TRUE, 
dest: IF calledFromSetDebuggerPtrs THEN SdebuggerLogicalString 
ELSE QinputLogicalString 
! Question => {ListLogicalVolumes[]: RESUME}]; 

IF calledFromSetDebuggerPtrs THEN { 

IF debuggerLogicalString.length=0 THEN (lvID *■ Volume . nul 1 ID: RETURN} 

ELSE inputstring «• debuggerLogicalString) 

ELSE (inputstring «- inputLogicalString}; 

DO 

driveTemp: PhysicalVolume.Handle; 

ItmpID: Volume.ID <- Volume. null ID; 

IF (ptmpID *■ Physical Vo I ume .GetNext(ptnipID]) = PhysicalVolume . nul 1 ID THEN EXIT; 
driveTemp «- Phys ical Volume .GetAttributes[ptmpID]. instance ; 

DO 

s: STRING = [maxNameLength]; 

IF (ItmpID *■ PhysicalVolume .GetNextLogicalVolume[ptmpID, ItmpID]) 

= Volume.null ID THEN EXIT; 

GetLogicalVolumeName[ltmpID, s ! Volume.NotOnline => LOOP]; 

IF FunnyEqual[driveTemp, s, inputstring] THEN ( 
matches «- matches + 1; lvID «■ ItmpID; pvID *■ ptmpID; drive «• driveTemp}: 
ENDLOOP; 

ENDLOOP; 

SELECT matches FROM 

0 => WriteString["Not found\r”L]; 
t => RETURN; 

ENDCASE => WriteLine["Ambigous; please specify Device:LogicaIName'Lj; 

ENDLOOP; 

END: 

FunnyEqual: PROC [ 

h: PhysicalVolume.Handle, name: STRING, userName: LONG STRING, 
mode: [checkNakedPName, dontCheckNakedPName} *■ dontCheckNakedPName] 

RETURNS[BOOLEAN] = { 
driveName: LONG STRING; 

SameChar: PROC [a, b: CHARACTER] 

RETURNS [BOOLEAN] = { 

IF a=b THEN RETURN[TRUE] 

ELSE IF a IN [’a..’z] AND b IN [’A..’Z] AND (a-'a+ , A)=b THEN RETURN[TRUE] 

ELSE IF a IN ['A..‘Z] AND b IN [’a..'z] AND (a-'A+'a)=b THEN RETURN[TRUE] 

ELSE RETURN[FALSE]}; 

IF String.Equivalent[name. userName] THEN RETURN[TRUE]; 
driveName *■ GetDriveStringName[h] ; 

IF userName.length < driveName.1ength THEN RETURN [FALSE]; 

FOR i: CARDINAL IN [0..driveName.1ength) DO 

IF ~SameChar[driveName[i], userName[ i ]] THEN RETURN[FALSE] ENDLOOP: 

IF mode=checkNakedPName THEN { 

IF (userName.length=driveName.length) 

OR (userName . length = driveName . length*-1 

AND userName[driveName.1ength] = ':) THEN RETURN[TRUE]}; 

IF driveName.1ength+name.1ength+I # userName.1ength THEN RETURN[FALSE]; 

IF userName[driveName.1ength] # ’: THEN RETURN[FALSE]; 

FOR 1: CARDINAL IN [0..name.1ength) DO 

IF ~SameChar[name[i], userName[driveName.1ength+l+i]] THEN RETURN[FALSEJ 
ENDLOOP: 

RETURN[TRUE]}; 

GetLvTypeFromUser; PUBLIC PROC [ 

prompt: LONG STRING, defauItType: Volume.Type] RETURNS [Volume.Type] = 

BEGIN 

ListTypes: PROC = { 

FOR t: Volume.Type IN [normal..nonPilot] DO 
Writestring[logicalVolumeTypeStringft]]; 

WriteString[IF t = nonPilot THEN "\r"L ELSE ", "L]; 

ENDLOOP}; 
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String.Replace[@lvTypeString, logical VolumeTypeString[defaultType], Heap.systemZone]; 

DO 

Get.Name[prompt, @1 vTypeString, echo, TRUE 
! Question => {ListType$[]; RESUME}]; 

FOR t: Volume.Type IN [normal..nonPilot] DO 

IF String.Equivalentpogical VolumeTypeString[t], 1vTypeString] THEN 
RETURN[t] 

ENDLOOP; 

WriteLine["Illegal type”L]; 

ENDLOOP; 

END; 

-- Accept string of Form PhysicalVolumeName OR 
Drive:PhysicalVolumeName OR Drive 
GetPvIDFromUser; PROC 

RETURNS [id: PhysicalVolume.ID, drive: PhysicalVolume.Handle] = 

BEGIN 

DO 

tmpID: Physical Volume. ID «■ PhysicalVolume .nul 1ID; 

matches: CARDINAL *• 0; 

GetName["Physical Volume Name: "L, OinputPhysString, , TRUE 
! Question => [ListPhysicalVolumes[]; RESUME}]; 

DO 

s: STRING = [maxNameLength]; 

match: BOOLEAN; 

driveTemp: PhysicalVolume.Handle; 

IF (tmpID «- Physical Volume .GetNex t[tmpID] ) = Phys icalVolume. nu 11 ID THEN 
EXIT; 

driveTemp «- PhysicalVolume .GetAttributes[tmpID, s]. instance; 
match «• FunnyEqual [driveTemp , s, i nputPhysString , checkNakedPName]; 

IF match THEN (matches «- matches +■ 1; id «- tmpID; drive *■ driveTemp}; 

ENDLOOP; 

SELECT matches FROM 

0 => WriteLine["Not FouncTL]: 
l => RETURN; 

ENDCASE => WriteLine["Ambigous; please specify Device:PhysicalName"L]; 

ENDLOOP; 

END: 

Stringlnit: PROC = ( 

SetCommandString[String.CopyToNewString["Online RD0"L, Heap.systemZone]]}; 
debuggerLogicalString *- String.CopyToNewString["CoPi lot"L, Heap. systemZone]; 

RegisterCommandProc[@commandProcessor]; 

Stringlnit[]; 

END. 

March 19, 1980 3:47 PM FXH Delete newly created temporary files when fetch fails: ome indentation changing 

April 16, 1980 12:16 PM RXG Addd diagnostic microcode fetch 

May 31, 1980 11:49 PM FXH Shuffle around VolumelnitlmplA and B 

July 30, 1980 4:33 PM AWL Permit Online'ing an already online volume 

September 18, 1980 12:04 PM PXM Don't bother to open volume to boot from 

September 19, 1980 11:24 AM AWL physicalVolumeOverhead «■ 2 for new physical volume format. 

September 29, 1980 2:07 PM CAJ Add SA800 format and scan, USING clauses. 

October 10, 1980 3:17 PM FXH Version 5.0. 

January 5, 1981 10:14 PM FXH Made use String for appendChar. equivilantString, appendLongNumber. Add TemporaryBooting. i nva I id 

parameter catch. 

January 31, 1981 9:19 PM CAJ Fix format prompt. 

March 1, 1981 12:59 PM AWL Version => 6.0b. 

March 13, 1981 7:22 PM SXY Version => 6.0c, trouple => trouble (correction), "Boot file header broken" = > "Error: Debuggee built by 

incompatible version of StartPilot". 

March 25, 1981 8:28 PM CRF Version => 6.0. 

April 14, 1981 11:38 AM BXM 0 added. 

11- Jun-81 10:53:01 Taft Remove all machine- and device-dependent code to separate module OthelloDevicelmplD*.mesa 

17-Jul-81 15:34:33 SCG Merged OthelloDevice into OthelloOefs 

12- Aug-81 12:33:54 SXY Added a catch phrase for Volume.GetAttributes and commented it out for Volume.GetLabelString 

5-Dec-81 17:30:28 CRF Converted from PhysicalVolumeExtras to PhysicalVolume for PV scavenger. 

ll-Dec-82 15:10:21 RXJ Removed Storage. 

13- /\pr-83 12:27:04 RXJ Klamath conversion 

4-Jun-86 14:09:04 NFS Adapted for OthelloTool 
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-- VolumeVersion.mesa 17-Aug-83 12:16:18 by WOK 

TEMPORARY HACK for Klamath <> Trinity cross volume problems. 

DIRECTORY 

Vo lume USING [ID]; 

VolumeVersion: DEFINITIONS = 

BEGIN 

Examine: PROCEDURE [volume: Volume.ID] 

RETURNS [result: Result]: 

Result: TYPE = { 

currentVersion. badRootPageLabel, ioError, trashedRootPage, 
otherVersion, volumeUnknown}: 

END. 


VolumeVersion.mesa 


17-Aug-83 1.2: 16:25 PDT 






-- Copyright (C) 1983, 1984 by Xerox Corporation. All rights reserved. 

--- VolumeVersionlmp 1 .mesa 17-Aug-83 11:20:47 by WDK 

--- SJD 28-Feb-84 14:10:16 

-- TEMPORARY HACK for Klamath <> Trinity cross volume problems. 

DIRECTORY 
Device, 

DiskChannel. 

Environment, 

File, 

Log leal VolumeFormat, 

OthelloOps, 

PhysicalVolume. 

PilotDisk, 

PilotFileTypes, 

Space. 

VM, 

Volume, 

VolumeVersion; 

VolumeVersionlmp1: PROGRAM 
IMPORTS 

DiskChannel, Environment, OthelloOps, PhysicalVolume. PilotDisk, Space, VM 
EXPORTS VolumeVersion = 

BEGIN 

Bug: SIGNAL [b: BugType] = CODE: 

BugType: TYPE - { 

impossibleEndcase, inval idChanne1 , invalidDriveState}; 

Examine: PUBLIC PROCEDURE [volume: Volume.ID] 

RETURNS [result: VolumeVersion.Resu1t] = 

BEGIN 

IvRoot: LONG POINTER TO LogicalVolumeFormat.Descriptor; 
physicalVol: Physical Volume.ID = 

Phys icalVo 1ume.GetContainingPhysicalVolume[volume]: 
pvHandle: PhysicalVolume.Handle = 

PhysicalVolume.GetAttributes[physicalVol].instance; 
deviceType: Device.Type: 
index: CARDINAL: 

subVolume: Othel loOps . SubVo I ume «- Othel 1 oOps . nul 1 SubVol ume : 
drive: DiskChannel.Drive: 

DO 

subVolume «■ OthelloOps. GetNextSubVol ume[phys ical Vol , subVolume]: 

IF subVolume - Othel 1 oOps . null SubVol ume THEN RETtJRN[volumeUnknown]: 

IF subVolume.IvID = volume AND subVolume.firstLVPageNumber = 0 THEN EXIT; 
ENDLOOP; 

IvRoot «- Space . ScratchMap[count: I],pointer; 

[type: deviceType, index: index] «- PhysicalVolume.InterpretHandle[pvHandle]; 
FOR drive «- DiskChannel .GetNextDrive[prev : DiskChannel. nul IDrive], 

DiskChannel.GetNextDrive[prev: drive] 

UNTIL drive = DiskChannel.nullDrive DO 
dType: Device.Type: 
dOrdlnal: CARDINAL; 

[deviceType: dType. deviceOrdinal: dOrdinal] <- 
DiskChanneI.GetDriveAttributes[drive]; 

IF dType-deviceType AND dOrdinal=index THEN EXIT 
ENDLOOP; 

BEGIN --scope of Exit-- 

pageBuffer: Environment.PageNumber - Environment.PageFromLongPointer[lvRoot]; 
channel: DiskChanneI.Handle = DiskChannel.Create[drive]: 
request: DiskChannel . IORequest *■ [ 

diskPage: subVolume.firstPVPageNumber. memoryPage: pageBuffer, 
tries: DiskChannel.defaultTries , label: ©label, 
count: 1, useSamoPage: TRUE, command: [verify, read, read]]: 
status: DiskChannel.IOStatus: 
countValid: File . PageCount: 
label: PilotDisk.Label: 

VM.MakeResident[[page: pageBuffer, count: L], wait]: 

[status, countValid] <- DiskChannel .DoIO[channel , ©request]; 

WITH boundStatus: status SELECT FROM 
invalidChannel -> Bug[invalidChannel]; 
invalidDriveState => Bug[invalidDriveState]; 
disk => 

IF boundStatus. status # goodCompletion THEN [result <- ioError; GOTO Exit); 
ENDCASE => Bug[impossibleEndcase]: 

Check Logical Root Page Label: 

IF volume = Volume.ID[1abel.fi1elD.id] 

AND PilotDisk.GetLabelFilePage[@label] = LogicalVolumeFormat.rootPageNumber 
AND ~1abel.temporary AND label.padl = 0 AND label.pad2 = 0 
AND label.type = PilotFileTypes.tLogicalVolumeRootPage 
THEN NULL ELSE [result *■ badRootPageLabel : GOTO Exit}; 

IF IvRoot.seal # LogicalVolumeFormat.IvRootSeal THEN 
[result *- trashedRootPage; GOTO Exit}; 

IF 1vRoot.version # LogicalVolumeFormat.currentVersion THEN 
[result *• otherVersion; GOTO Exit}; 
result <- currentVers ion : 

EXITS Exit => NULL 
END; 
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IvRoot *- Space .Unmap[lvRoot] ; 
END; 


END, 
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Copyright (C) 1982, 1983 by Xerox Corporation. All rights reserved. 
-- OthelloOps.mesa 16-Aug-83 13:33:02 by JXP 


DIRECTORY 

Device USING [Type], 

File USING [File, PageNumber], 

PhysicalVolume USING [Handle, ID, PageNumber], 

System USING [GreenwichMeanTime, LocalTimeParameters, 

Volume USING [ID, nullID, PageCount]: 


Operations useful to volume utilities. 
OthelloOps: DEFINITIONS = 


Switches], 


BEGIN 


DecodeSwitches: PROC [switchString: LONG STRING] 

RETURNS [switches: System.Switches]; 

BadSwitches: ERROR; 

DeleteTempFIles: PROCEDURE [Volume.10]: 

VolumeNotClosed: ERROR: 

GetDrlveSIze: PROCEDURE [h: PhysicalVolume.Handle] 

RETURNS [nPages: LONG CARDINAL]; 

-- returns total size, ignoring reserved spaces, etc. 

BtootFileType: TYPE = (hardMicrocode, softMicrocode, germ, pilot); 

MakeBootable, MakeUnbootable: PROCEDURE [ 

file: File.File, type: BootFileType, firstPage: File.PageNumber]; 

InvalidVersion: ERROR: 

-- Prepare (or undo) chains for making a file bootable. 

There is no need to remove bootlinks merely to delete 
-- a file. Boot links should be removed before any increase or decrease in 
-- the size of a file, and reinstalled after the operation. 

SetVolumeBootFlie, SetPhysicalVolumeBootFile: PROCEDURE [ 
file: File.File, type: BootFileType, firstPage: File.PageNumber]; 

GetVolumeBootFile: PROCEDURE [lvID; Volume.ID, type: BootFileType] 

RETURNS [file: File.File, firstPage: File.PageNumber]; 

GetPhysicalVolumeBootFile: 

PROCEDURE [pvID: PhysicalVolume.ID, type: BootFileType] 

RETURNS [file: File.File, firstPage: File.PageNumber]; 

VoidVolumeBootFIle: PROCEDURE [lvID: Volume.ID, type: BootFileType]; 
VoidPhysicalVolumeBootFlie: 

PROCEDURE [pvID: PhysicalVolume.ID. type: BootFileType]: 

SetDebuggerSuccess: TYPE = ( 

success, nullBootFile, cantWriteBootFi1e, notlnitialBootFile, 
cantFIndStartListHeader, startLIstHeaderHasBadVersion, other, noDebugger): 
SetGetSwitchesSuccess: TYPE = SetDebuggerSucces$[success..other]; 

SetExpiratlonDateSuccess: TYPE = SetDebuggerSuccess[success..other]: 

GetExpirationDateSuccess: TYPE = SetDebuggerSuccess[success..other] ; 

SetDebugger: PROCEDURE [ 

debuggeeFile: File.File. debuggeeFirstPage: File.PageNumber, 

debugger: Volume.ID, debuggerType: Device.Type. debuggerOrd inal: CARDINAL] 

RETURNS [SetDebuggerSuccess]; 

SetExpirationDate: PROCEDURE [ 

file: File.File, firstPage: File.PageNumber. 
expirationDate: System.GreenwichMeanTime] 

RETURNS [SetExpirationDateSuccess]; 

GetExpirationDate: PROCEDURE [file: File.File, firstPage: Fi1e.PageNumber] 
RETURNS [GetExplrationDateSuccess, System.GreenwichMeanTime]; 

SetSwitches: PROCEDURE [ 

file: File.File, firstPage: File.PageNumber, switches: System.Switches] 
RETURNS [SetGetSwitchesSuccess]; 

GetSwitches: PROCEDURE [file: File.File, firstPage: File.PageNumber] 

RETURNS [SetGetSwitchesSuccess, System.Switches]: 

-- Physical layout of subvolumes on a physical Volume: 

LogicalVolumePageNumber: TYPE = LONG CARDINAL: 

SubVolume: TYPE - RECORD [ 

lvIO: Volume.ID, 

subVolumeSize: Volume.PageCount. 

firstLVPageNumber: LogicalVolumePageNumber, 
firstPVPageNumber: PhysicalVolume.PageNumber]; 

nullSubVolume: SubVolume - [Volume.nullID. 0, 0, 0]: 

GetNextSubVolume: PROCEDURE [pvID: PhysicalVolume.ID. thisSv: SubVolume] 
RETURNS [nextSV: SubVolume]; 

SubVolumeUnknown: ERROR [sv: SubVolume]; 

-- Time related functions: 

IsTimeValid: PROCEDURE RETURNS [valid: BOOLEAN]; 

-- Returns TRUE if the processor clock appears to be set correctly. 
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SetProcessorTime: PROCEDURE [time: System.GreenwichMeanTime]; 

-- Sets the processor clock to the specified value. In general, the 
-- clock should NOT be set backwards from that returned by 
-- System.GetGreenwhichMeanTime. 

GetTimeFromTimeServer: PROCEDURE [] 

RETURNS [ 

serverTime: System.GreenwichMeanTime, 
serverLTPs: System.LocalTimeParameters]: 

-- Attempts to access a time server to determine what time it currently is 
-- and the local time parameters that the server is using. Will 
-- raise TimeServerError if this operation fails. 

TimeServerError: ERROR [error: TimeServerErrorType] ; 

TimeServerErrorType: TYPE = (noCommunicatlonFaci1ities. noResponse}; 

END. 


--LOG 

July 13. 80 7:17 PM FXH 

Create from old OthelloOps and Old OthellolnternaI Interface 

11- Aug-81 15:14:43 AWL 

DecodeSwitches takes a LONG STRING. Switches now in System. Added SetProcessorTime. 

GetTimeFromTimeServer and TimeServerError. 

10 Nov 81 13:46:00 JXP Added InvalidVersion ERROR. 

12- Nov-81 9:46:49 FXH Add SetExpirationDate. 

24-Nov-82 9:12:20 AWL 

Add GetExplrationDate. GetExpirationDateSuccess. FIle.Capabl1ity => File.File. Renamed "cap" arguments to "file" 
27-Jun-83 17:40:34 WDK Added pilotSnapshot. 

Time: 11-Jul-83 14:30:56 By: JXP 

The parm. debuggeeCap => debuggeeFile in SetDebugger. 

Time: 16-Aug-83 13:33:12 By: JXP 

Decommision the pilotSnapshot BootFileType for the time being. 


Othelloops.mesa 


16-Aug-83 13:34:09 PDT 




-- Copyright (C) 1983 by Xerox Corporation. All rights reserved. 

-- SpeclalVolume.mesa 2-Jul-83 18:18:31 by WDK 

DIRECTORY 

Boot USING [LVBootFiles, PVBootF1les], 

PhysicalVolume USING [ID, PageNumber], 

System USING [GreenwichMeanTime], 

Volume USING [ID, nullID, PageCount, Type]: 

SpecialVolume: DEFINITIONS = 

BEGIN 

Log I cal VolumePageNumber: TYPE = LONG CARDINAL; 

SubVolume: TYPE = RECORD [ 

IvID: Volume.ID, 

subVolumeSize: Volume.PageCount, 
fIrstLVPageNumber: LogicalVolumePageNumber, 
f irstPVPageNumber: PhysicalVolume.PageNumber]; 

nullSubVolume: SubVolume = [ 

Volume.nulHD, LAST[Volume.PageCount], LAST[LogicaIVolumePageNumber], LAST[ 
PhysicalVolume.PageNumber]]; 

GetNextSubVolume: PROCEDURE [pvID: PhysicalVolume.ID, this: SubVolume] 

RETURNS [next: SubVolume]: 

-- Stateless enumeration of subVolumes. 

-- Enumerations starts and ends with nul1SubVolume. 

SubVolumeUnknown: ERROR; 


OpenVolume: PROCEDURE [volume: Volume.ID, access: Access]: 

-- Opens a volume while explicitly controlling its writability 
-- (independent of its type). 

Access: TYPE = (read, readWrite, default}: 


ChangeVolumeType: PROCEDURE [IvID: Volume.ID, newType: Volume.Type]; 

<< Changes the type of a volume. Note that changing a volume’s type affects 
the selection of its debugger. The safest procedure is to change a volume’s 
type from UtilityPilot with no other logical volumes open 
and then reinstall all debuggers on that physical volume. 

If the volume is not open for read/Write, InvalidParameters is raised. >> 

Invalid Parameters: ERROR: 

LastOpenedForWrite: PROCEDURE [IvID: Volume.ID] RETURNS [System.GreenwichMeanTime]: 


-- Get/set boot file pointers: 

Getl.ogicalVolumeBootFIles: PROCEDURE [ 

IvID: Volume.ID, pBootFiles: LONG POINTER TO Boot.LVBootFi les]; 

GetPhysicalVolumeBootFiles: PROCEDURE [ 

pvID: PhysicalVolume.ID, pBootFiles: LONG POINTER TO Boot.PVBootFiles]; 

SetLogicalVolumeBootFi1es: PROCEDURE [ 

IvID: Volume.ID, pBootFiles: LONG POINTER TO Boot.LVBootFiles]; 

SetPhysicalVolumeBootFiles: PROCEDURE [ 

pvID: PhysicalVolume.ID, p8ootFiles: LONG POINTER TO Boot.PVBootFi1es]; 

END., 


LOG 

May 15. 80 4:40 PM PXM 

Equate PhysicalVolume.ID to same type in System 
Jun 28, 80 5:23 PM FXH 

Eliminate procedures now defined in other interfaces, and ReGroup adding some comments about moving Procedures. 
[Get|Set][Logical|Physlccal]Volume8ootFiles to KernelFile. 

GetContaining PhysicalVolume to PhysicalVolume. 

Jul 13. 80 9:15 PM FXH Move most procedures elsewhere. 

Jul 28, 80 2:33 PM AWL Added nul1SubVolume. SubVolumeUnknown. 

ll-Auc|-8t 11:29:26 AWL Added OpenVolume from VolumeExtras. 

2- NOV-81 11:28:26 AWL 

Changed "readonly: BOOLEAN" arg to OpenVolume to "access: Access". 

5-0ct-82 16:15:15 AWL 

Added ChangeVolumeType procedure and InvalidParameters error. 

3- Feb-83 16:40:20 LXD 

Redefined error conditions for ChangeVolumeType. 

2-Jul”83 18:18:36 WDK Improved documentation. Added LastOpenedForWrite. 


Move 
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- Copyright (C) 1982, 1983 by Xerox Corporation. All rights reserved. 

-- FemporaryBooting.mesa (last edited by: JXP on: 6-Jul-83 15:23:15) 


DIRECTORY 

Environment USING [PageCount], 

File USING [File, PageNumber, Type], 

Physical Volume USING [ID], 

System USING [defaultSwitches, Switches], 

Volume USING [ID]; 

TemporaryBooting: DEFINITIONS = 

BEGIN 

tBootFile: READONLY File.Type; 

Only files of this type may be made bootable. 

MakeBootable: PROCEDURE [file: File.File, firstPage: File . PageNumber «- 0]; 

Install the chaining links in the labels of the file pages starting with the specified 
first page and for the length of the contained Pilot boot file. 

--- MakeBootable must be performed after contents are written and before file is passed to 
BootFrom. 

Inval idParameters is raised If file is of wrong type or doesn't contain Pilot boot file 

- starting at firstPage. 

MakeUnbootable: PROCEDURE [ 

file: File.File, firstPage: File.PageNumber «- 0]; 

- Remove the chaining links. May speed subsequent bulk access to the file. 

Instal1VolumeBootFile: PROCEDURE [ 

file: File.File, firstPage: F ile . PageNumber «- 0]; 

-- Set up the file as the one gaining control when the containing (logical) volume is booted. 

InstallPhysicalVolumeBootFile: PROCEDURE [ 

file: File.File, firstPage: File.PageNumber *- 0]; 

Set up the (logical) volume as the one gaining control when the containing physical 
volume is booted. 

BootfromFile: PROCEDURE [ 

file: File.File. firstPage: File. PageNumber *• 0, 
switches: System.Switches «■ System .defaul tSwi tches]; 

--- Restart the system from the specified boot file. Improper arguments will likely result 
in an MP code and crash. 

BootFromVolume: PROCEDURE [ 

volume: Volume.ID, switches: System. Switches «- System.defaultSwitches] : 

- Restart the system from the Pilot boot file installed on the specified volume. 

Boot.FromPhysicalVolume: PROCEDURE [ 

volume: Volume,ID, switches: System.Switches «■ System .defaul tSwitches] : 

--- Restart the system from the Pilot boot file installed on the physical volume 
-- containing the specified (logical) volume, 

BootButton: PROCEDURE [switches: System. Swi tches «■ System .defaul tSwitches]; 

-- Restart the system as if its boot button had been pressed (may ignore switches). 

BootLocation: TYPE = RECORD [ 

body: SELECT bootLocation: * FROM 
bootButton, none => NULL, 
physicalVolume => [pvLocation: PVLocation], 
logical Volume => [volumeLocation: VolumeLocation], 
file => [fileLocation: FileLocation], 

ENDCASE]; 

-- Describes a place that the state of a running Pilot may be saved In, or 
-- restored from. 

Currently, it is only possible to save state in a file BootLocation, 

-- A bootButton BootLocation is always valid. The other variants are only valid 
-- for limited periods of time, as denoted below. The conservative approach is 
-- to never store these other variants in a permanent location and to always 
-- recreate them just before calling OutLoadlnLoad. 

PVLocatlon: TYPE [11]; 

VolumeLocation: TYPE [11]: 

FileLocation; TYPE [11]; 

The following procedures return a BootLocation for the specified location. 

-- For each operation, the circumstances under which the returned information 
-- becomes invalid Is noted. 

GetFileLocation: PROCEDURE [ 

file: File.File, firstPage: File. PageNumber «- 0] 

RETURNS [bootLocation: file BootLocation]; 

-- The returned BootLocation is valid so long as the specified file is 
-- neither deleted or has any of its attributes changed (including size 
-- and permanency). Scavenging may invalidate the returned BootLocation 
-- if the file was damaged and the client scavenger repaired the damage. 

-- The returned BootLocation is also only valid if the specified file has 
-- been made bootable (via femporaryBooting.MakeBootable) and is not 
-- subsequently made unbootable. 

- May raise File.Unknown, Volume Unknown. 

-- Raises FemporaryBooting.InvalidParameters if the specified file page is 
-- beyond the end of the file. 

GetVolumeLocation: PROCEDURE [volume: Volume.ID] 

RETURNS [bootLocation: logicalVolume BootLocation]; 

-- The returned BootLocation is only valid so long as the boot files are 
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-- not changed on the specified volume. The comments for the validity of 
-- returned BootLocations in GetFIleLocation also apply here. 

-- Raises TemporaryBooting.InvalidParameters if the specified volume does 
-- not have a Pilot boot file installed on it. 

-- May raise Volume.Unknown, Volume.NotOpen. 

GetPVLocation: PROCEDURE [volume: PhysicalVolume.ID] 

RETURNS [bootLocatlon: physical Volume BootLocation]: 

-- Valid so long as the boot files are not changed on the specified 
-- physical volume. The comments for the validity of returned BootLocations 
-- in GetFileLocation also apply here. 

-- Raises TemporaryBooting,InvalidParameters if the specified volume does 
-- not have a Pilot boot file Installed on it. 

-- May raise PhysicalVolume,Error[physicalVolumeUnknown]. 

OutLoadlnLoad: PROCEDURE [ 

outloadLocation: file BootLocation, loaciton to save current system 
The following describe the instance of Pilot to be restored 
inioadLocation: BootLocation, 

pMicrocode, pGerm: LONG POINTER NIL, countGerm; Envlronment. PageCount *■ 0, 
switches: System. Switches *■ System.defaul tSwitches] ; 

-- The state of the currently running Pilot is saved on outloadLocation. 

-- The Pilot represented by inloadLocation is restored to a running state. 

-- The microcode and/or germ may be changed by passing the appropriate 
-- information in pMicrocode, pGerm and countGerm, If these pMicrocode is 
-- defaulted, the microcode is not changed. If pGerm is defaulted, the germ 
-- is not changed. 

-- The switches are available to the inloaded Pilot. These are typically 
-- only examined when the Pilot being booted is not an outload file (e.g., It 
-- was made by MakeBoot). Note that, the switches may be ignored if 
-- inloadLocation is a bootButton BootLocation. 

-- Upon return, the client has successfully performed the outload and someone 
-- else later has requested that THIS instance of Pilot be inloaded. 

InvalidParameters: ERROR: 

InvalidVersion: ERROR: -- Note that this error is raised by MakeBootable AFTER the 
-- the file is made bootable. 

END. 


--LOG 

Time: September 14, 1979 2:45 PM By: PXM 

Create file 

Time: October 3, 1979 6:17 PM By: PXM 

Add Instal1AsBoot* 

Time: January 25, 1980 10:58 AM By: PXM 

InstallAsBootFile=>InstalIVolumeBootFi1e; 

InstallAsBootVolume[vol ] = >Insta11 Physical BootVolume[file]: add BootFromPhysicalVolume, 

Boot: add Switches to Boot* 

Time: April 17, 1980 10:34 AM By: PXM 

Default for firstPage to BootFrmFile missing 
Time: 9-Aug-81 15:03:38 By: AWL 

Switches now in System. 

Time: 10-Nov-81 13:45:00 By: JXP 

Added InvalidVersion ERROR, 
rime: 22-Nov-82 16:03:03 By: AWL 

File.Capability => File.File. 

Time: 30-Mar-83 17:25:52 By: AWL 

Added BootLocation, PVLocation, VolumeLocation, Fi1eLocation , GetFileLocation, GetVolumeLocation, GetPVLocation, 
Time: 6-Jul-83 15:25:51 By: JXP 

Added "none" variant to BootLocation 


OutLoadlnLoad. 
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-- File: QuickRestartClientlmpl.mesa - last edit: 
-- Mil,a 27-Jan-88 14:15:09 

-- Breisacher 21-Oct-87 9:40:58 


Copyright (C) 1987, 1988 by Xerox Corporation. All rights reserved. 

DIRECTORY 

Boot USING [LVBootFIles], 

File USING [Delete. File, nullFile. Unknown], 

LevelIVKeys USING [KeyBIts, KeyName], 

NSConstants, 

Space USING [Copyln, ScratchMap, Unmap]. 

String USING [Equivalent], 

SpecialVolume USING [GetLogicalVolumeBootFi1es, LastOpenedForWrlte. OpenVolume], 

OthelloOps USING [GetTImeFromTimeServer. SetProcessorTime, TimeServerError], 

PhysicalVolume USING [ 

AssertPilotVolume, Error, GetHandle. GetNextDrlve, Handle, ID, 

NeedsScavenglng, nullDevIcelndex, nullID], 

PilotMP USING [cScavenging, cDIskHardwareError, cTImeNotAvai1 able, cClient], 

ProcessorFace USING [SetMP], 

PowerOffRestartlnternal USING [CheckHandle, outloadFileType, flrstPage], 

Router USING [FindDestinationRelativeNetlD], 

Scavenger USING [Scavenge], 

System USING [GreenwlchMeanTime, LocalTimeParameters, NetworkNumber, nu l INetworkNumber, SetLocalTimeParameters] , 

TomporaryBooting USING [BootFromFi1e, BootFromVolume , InstallPhysicalVolumeBootFile, InvalIdParameters], 

UserTerminal USING [WaitForScanline, keyboard], 

Volume USING [GetNext, GetLabelString, ID, maxNameLength, NeedsScavenging, nullID, 

LookUpRootFile, Open, RootDirectoryError, Unknown]; 

QuickRestartClientlmpl: PROGRAM 
IMPORTS 

File, OthelloOps, PhysicalVolume, ProcessorFace, Router, Scavenger, Space, SpecialVolume, String, 

System, TemporaryBootlng, UserTerminal, Volume = 

BEGIN 

userVolume : Volume. ID «- Volume . nul 1 ID: 

CheckOutloadOK: PROC [volumeName: LONG STRING] 

RETURNS [inload: File.File, proceed: BOOLEAN] = 

BEGIN 

outloadFile: File.File «- File.nullFile; 
userVolume *■ GetVolumeID[volumeName] ; 
proceed <- FALSE; 

IF userVolume # Volume.nul1 ID THEN { 

Special Volume.OpenVolume[userVolume. readIVolume.NeedsScavenging = > {Log1calVolumeScavenge[userVolume]; CONTINUE}]; -- delete 

because this Is permanent. 

outloadF ile <- Volume .LookUpRootFile[ 

PowerOffRestartlnternal.outloadFileType, userVolume!Volume.RootDirectoryError => GOTO Errors]; 

IF outloadFile # File.nulIFile THEN { 

check: PowerOffRestartlnternal.CheckHandle = Space.ScratchMap[1]; 
proceed <■ Checkoutloaded[outloadFile, check!File.Unknown=> GOTO Errors]; 

IF proceed THEN proceed *■ (check.lastNetworkNumber = System.nul 1 NetworkNumber) OR (LocalNet[] = check. 1 astNetworkNumber); 
Inload *■ outloadFile; 

[] *■ Space,Unmap[check]}; 

}: 

EXITS Errors = > {proceed <- FALSE; RETURN}; 

END: 

LogicalVolumeScavenge: PROC [volume: Volume.ID] = 

BEGIN 

scavenger!og: File.File; 

ProcessorFace.SetMP[PilotMP.cScavenging]; 

scavengerlog <- Scavenger.Scavenge[volume. volume, safeRepair, FALSE]; 

Volume.Open[volume]; 

File.Delete[scavengerlog]; 

ProcessorFace.SetMP[PilotMP.cClient]: 

END; 


CheckOutloaded: PROC [file: File.File, check: PowerOffRestartlnternal.CheckHandle] 
RETURNS [out: BOOLEAN] = { 

scavengerVolume: Volume. ID <- GetVolumeID["Scavenger"L] ; 

[] «• Space .CopyIn[check, [file. 0, 1]]; 
out <- check.valid AND 

(check.1astWriteDateinUserVolume = SpecialVolume.LastOpenedForWrite[ 
userVolume]) 

AND 

(check.1astWriteDateinScavengeVolume = SpecialVolume.LastOpenedForWrite[ 
scavengerVolume])}; 

GetVolumelD: PROC [svVolume: LONG STRING] RETURNS [vl: Volume.ID] I 
BEGIN 

svLabel: STRING = [Volume.maxNameLength]; 
vl <- Volume . nul 1 ID; 

UNTIL (vl «■ Volume .GetNext[vl ] ) = Volume, nul 1 ID DO 
Volume,GetLabelString[vl, svLabel]; 

IF String.Equivalent[svVolume, svLabel] THEN EXIT; 

ENDLOOP; 

END; -- of GetVolumelD 

LocalNet: PROC RETURNS [System.NetworkNumber] 3 [ 

RETURN[Router.FindDestinationRelativeNe11D[System.nulINetworkNumber]]; 

}; 


Run: PROCEDURE = 
BEGIN 
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userVolName: LONG STRING <- "User"L; 
tJmeFromServer: BOOLEAN «■ TRUE; 
dolnload: BOOLEAN «- TRUE; 
timer System.GreenwichMeanTime; 

Itps: System.LocalTimeParameters; 
inloadFile: File.File; 

ProcessorFace.SetMP[PilotMP.cTimeNotAvaiTable]; 

[time, 1 tps3 «■ OthelloOps.GetT1meFromTimeServer[ 

! Othelloops.TimeServerError => RETRY]; 

IF timefromServer THEN { 

System.SetLocalT1meParameters[ltps]; OthelloOps.SetProcessorTime[time]}; 

If there is no Time server boot from scratch, 
dolnload *■ timeFromServer; 

IF dolnload THEN dolnload *■ BringFirstReadyPhysicalVol umeOnl ine[] : 

IF ~doIn1oad THEN -- Can not Online Volume 

{ProcessorFace.SetMP[PilotMP.cDlskHardwareError]; RETURN) 

ELSE {FOR i:CARDINAL IN[0..5) DO UserTerrainal.WaUForScanLi ne[0 J; 
dolnload «• ~KeysAreDown[keyl: N, key2: B]; 

IF ~doInload THEN EXIT; 

ENDLOOP; 

}: 

IF dolnload THEN [InloadFile, dolnload] «- CheekOutloadOK[userVolName]; 

IF dolnload THEN [] *• TemporaryBooting.BootFromFile[ 

inioadFIle, PowerOffRestartlnternal.firstPagefTemporaryBooting.InvalidParameters, Volume.Unknown, File.Unknown, 
Volume.NeedsScavenging => {dolnload *■ FALSE; CONTINUE}]; 

-- "only returns if couldn't inload” WDK 

IF userVolume=Volume.nul1 ID THEN userVolume «• GetVolume :D["User"L] ; 

SetPhyslcalBoot[userVolume]; 

TemporaryBooting.BootF romVolume[userVolume] 

END; -- Run 

KeysAreDown: PROCEDURE [keyl, key2: Level IVKeys .KeyName] RETURNS [BOOLEAN] = { 
keys: LONG POINTER TO LevelIVKeys.KeyBits = LOOPHOL£[UserTerminal.keyboard]; 

RETURN[(keys[keyl] = down) AND (keys[key2] = down)]; 


BringFIrstReadyPhysicalVolumeOnline: PROC RETURNS [BOOLEAN] = 
BEGIN 

drivelndex: CARDINAL <- Phys leal Volume .nul IDeviceIndex; 
driveHandle: PhysicalVolume.Handle; 
pvID: Physical Volume.ID; 


DO -- loop looking for drives connected to this machine 
pvID <- PhysicalVolume .null ID; 

drivelndex *■ PhysicalVolume .GetNextDrl ve[drivelndex] ; 

IF drivelndex = PhysicalVolume.nulIDeviceIndex THEN EXIT; 
driveHandle «• PhysicalVolume.GetHandle[drivelndex]; 

IF TRUE <<Phys1calVolume.IsReady[dr1veHandle]>> THEN 
BEGIN 

<<IsReady doesn't work properly. Thus the following code is necessary.» 
pvID «■ PhysicalVolume .AssertPilotVolume[ 
driveHandle ! 

PhysicalVolume.Error, PhyslealVolume.NeedsScavenging => CONTINUE]; 

IF pvID = PhysicalVolume.nullID THEN EXIT; 

RETURN[TRUE]; 

END; 

ENDLOOP; -- end of loop until a drive is selected 
RETURN[FALSE]; 

END; — of BringF1rstReadyPhysicalVolumeOnIine 


SetPhysicalBoot; PROCEDURE [lvID; Volume.ID] = { 
bootFIles: Boot.LVBootFiles; 

SpecialVolume.GetLogicalVolumeBootF11es[lvID, SbootFiles]; 

Volume,0pen[lvID!Volume.NeedsScavenging=> {LogicalVolumeScavenge[lvID]; CONTINUE;}]; 
TemporaryBooting.Ins tall PhysicalVolumeBootFlie [ 
file: [bootFiles[pilot].fID.fileID, lvID], 
firstPage: bootFi1es[pi1ot].firstPage]; 

>; 

-Main 
Run[] ; 


END. 

LOG 

- Create from QuickBoot hack. 

- Support Time service 

- Incorporate suggestion from D KNUTSEN(various clean up) 

- N B = Normal Boot 

- Catch signal File.Unknown fo r checkoutloadOK 

- Do not crash when user select NB 

- AR14143 Fix. 

- If workstation Is moved to a different net while powered off, we now detect that and do a normal boot. 

Set physical volume boot back to User volume if we don't do the inload. 

- AR17622: The workstation is not booted as normal by "N" and "B" keys. To fix this. I fix the 915 problem I 
will do scavenge User volume, see LogicalVolumeScavenge . 
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File: QuickRestart.bootmesa - last edit: 

M1ta.ES 15-Oct~87 20:23:35 

-- Copyright (C) 1987 by Xerox Corporation. All rights reserved. 

--- Make all Unpackaged and Packaged code and global frames resident. 
RESIDENT: 

GLOBALFRAME[ALL] , 

CODE[ALL], 

FRAME[ALL], 

CODE.PACK[ALL] ; 

LOG [Time - Person - Action] 

L5-Oct-87 20:23:48 - Mita - Renamed 
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--QuIckBootDes ignNote. txt 
--Makoto Mita 


5-Feb-87 16:17:18 


As QuIckBoot is so tricky, I would like to leave some note. 

0. This application use File Type to make Outloaf file 

0 page has information on Last opened date of User and scavenger volume.Also this outload file is valid or not. From 1 page Outload image 
will be stored. Although this is File.File this file is acctually Temporaly file, so should be deleted at boot time. I made a double 
check to Volume.LookupFll and Delate file which should be deleted at boot t1me(MP960). We need this because we used to have the problem 
in the scavenger volume filled up by the Extrabackingflie which should be deleted because originally created for the temporaly. This 
file will not be deleted even by the pilot scavenge. Ask Lee Breisacher for more details. 

1. AT creating and deleting outload file, BWS set Priority 3 and fork another Process to prevent all the othe process running. 

This is necessary since, While writing snapshot and change some outload file, a process may change current disk status, which will mess 
up outload file. 

2. Wait 1 second before set to process 3. 

It seems Idle control look at the WorkstationProfile and decide wheter he displays bouncing keyboard or not. which will take at least 500 
seconds.(I found) 

So never set this 1 second to less. 

3. Kernel.makeboot is very important, Otherwise boot will end up 921. 

4. We call System.PowerOff because SpecialVolume.LastOpenedForWrite is the date which volume last opened for write not the last write 
operations' date. 
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-- File: PowerOffRestartlmpl.mesa - last edit: 
-- Mita.ES 18-Feb-88 14:43:46 


-- Copyright (C) 1987, 1988 by Xerox Corporation. All rights reserved. 

~~ OVERVIEW: PowerOffRestartlmpl which actually manage a OutLoad file in USer volume. Throught the PowerOffRestart Interface you can 
access anything. 

--Note Outload file will be deleted automatically when the logonCompleted. 

« OVERALL DESIGN COMMENTS: wdk 

Make the swap check file and the outload file both be ***temporary** files. This has the wonderful property that, if some other agent 
opens the volume for write, the files that we don't want to use anyway will be deleted automatically! Nice. [Picture of Dale patting 
self on back.] 

o Simplifying idea. Make swap check file and inload file all be one file. The swap check data is page zero, the inload part starts at 
page one. This means less code to manage files. 

o When creating and deleting files etc, be very careful of the order of operations so that a crash does not leave orphan flies on the 
disk. Put comments in the code noting the required order e.g. 

xxx; -- 1 of 3 

xxx; — 2 of 3 

xxx; -- 3 of 3 

o This program should not know the name of the "user" volume. Its main volume is Volume.systemID and the optional otherVolume parameter 
I mentioned In my proposed new interface. 

o If QuickRestartCllentlmpl does a normal boot, it should first delete all files that this module created. 

>> 


fhls procesdure has the KLUDGE, find by this pattern. 


DIRECTORY 

ApplIcationFolder USING [FromName], 

Boot USING [LVBootFlies], 

BootFile USING [maxEntriesPerHeader, maxEntriesPerTrailer, 

MemorySizeToFileSize], 

BWSFileTypes USING [systemFIleCatalog], 

Catalog USING [Open], 

Courier, 

Environment USING [PageNumber], 

File USING [ 

Create, Delete. File, nullID, nullFile, PageNumber, Type, 

Unknown], 

KernelFile USING [MakeBootable], 

NSFile, 

NSSegmentlnternal USING [GetID], 

NSString, 

Process USING [GetPriorlty, Pause, Priority, SecondsToTicks. SetPrlority, Yield], 

ProcessorFace USING [PowerOff], 

ProcessorFaceExtras USING [Version], 

ProcessPriorlties USING [priorityPageFaultLow], 

Snapshot USING [OutLoad], 

Space USING [CopyOut, Map, Unmap], 

SpecialSpace USING [realMemorySize], 

SpeclalVolume USING [LastOpenedForWrite, GetLogicalVolumeBootFties], 

PowerOffRestart, 

PowerOffRestartlnternal, 

ProductFactoring, 

System, 

TemporaryBooting USING [ 

InstallPhyslcalVolumeBootFile, InvalidParameters, MakeBootable], 

VPPFOptions, 

Volume USING [ GetAttributes, ID, InsuffIcientSpace, InsertRootFile, LookUpRootFile, nullID, Readonly, RemoveRootFile, 

RootDirectoryError, systemID], 

XStrlng; 

PowerOffRestartlmpl: PROGRAM 
IMPORTS 

ApplicationFolder, BootFile, Catalog, Courier, File, NSSegmentlnternal, Process, 

ProcessorFace, ProcessorFaceExtras, ProductFactoring, Snapshot, Space, SpecialSpace, SpecialVolume, System, Volume, KernelFile, 
NSFile, NSString, TemporaryBooting, XString 
EXPORTS PowerOffRestart = 

BEGIN 

specialBootf i rstPage: File .PageNumber *■ 1; -- We use page 0 for special info. 

dlionname: NSString.String «* NSString.StringFromMesaStr1ng["QuickRestartDlion.boot"G]; 
dovename: NSString.String «- NSString.StringFromMesaString["QuickRestartDove.boot"G]; 
kikuname: NSString . String <- NSString.StringFromMesaString["QuickRestartK1ku,boot"G]; 

SpaceError: PUBLIC ERROR [requestedPage: Envlronment.PageNumber, availablePage: Environment.PageNumber] = CODE: 

Error: PUBLIC ERROR [type: PowerOffRestart.ErrorType] = CODE; 


outloadFile: File.File «- Fi le . nul IFIle ; 
bootFlie: File.File; 

fileSize: LONG CARDINAL *- BootFile.MemorySizeToFileSize[ 
SpecialSpace.realMemorySize] ; 

DeleteOutLoad: PROC = 

BEGIN 

outloadFile «- Volume.LookUpRootFile[ 

PowerOffRestartlnternal.outloadFileType, Volume.systemID ! 
Volume.RootDirectoryError => CONTINUE]; 

IF outloadFile # Fi1e.nul1Fi1e THEN [ 
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--need to delete file first, then remove from directory. Otherwise, 
important.] wdk 

F lie.Delete[outloadF11e ! File.Unknown => CONTINUE]; 

Volume.RemoveRootFile[ 

PowerOffRestartInternal.outloadFileType, Volume.systemID ! 
Volume.RootDirectoryError => CONTINUE]; 


END; —DeleteOutLoad 


crash would orphan the file. 


[insert comment explaining why order 


DeleteBootFile: PROC = 

BEGIN 

--Temporaly Proc for BWS4.3g 

parentFh: NSFile.Handle «■ Catalog .Open[BWSFileTypes . systemFileCatalog] ; 
bootFH; NSFile.Handle *■ NSFile . nul IHandle ; 
filters: ARRAY [0..1) OF NSFile.Filter <- [ 

[mat che s[ [ name [NSSt ring . Str1ngFromMesaString["QuickRestart*. boofLimil: 
bootFH *• NSFile.Find[ 

directory: parentFh, scope: [filter: [and[DESCRIPTOR[filters]l]] ! 

NSFile.Error => CONTINUE]; 

IF bootFH = NSFile.nullHandle THEN RETURN; 

NSFile.Delete[bootFH! 

NSFile.Error => CONTINUE]; 

END; --DeleteBootFile 


FindQuickRestartBootfile: PROC [] RETURNS [BOOLEAN <- FALSE] = 

BEGIN 

parentFh: NSFile.Handle *■ NSFile. nullHandle ; 

internalNameRB: XString. ReaderBody * XStr1ng.FromSTRING["Power Off Quick RestarfL]: 
applicationfolder: NSFi!e.Reference <- NSFile.nullReference: 
bootFH: NSFi le . Handl e *■ NSFI 1 e . nullHandle; 
filters: ARRAY [0..1) OF NSFi 1 e . Fi 1 ter 4 - [ 

[matches[[name[HardwareDependentBootfile[]]]]]]; 
applicatlonfolder *■ ApplicationFolder.F r omN ante [@ internalNameRB ]; 

IF appl 1 cat 1 onfolder=N$F11e.nullReference THEN RETURN; 

parentFh * NSFile.OpenByReference[applicationfolderINSFi1e.Error => CONTINUE]: 

IF parentFh=N$Flie.nullHandle THEN RETURN; 
bootFH *■ NSFile.Find[ 

directory: parentFh, scope: [filter: [and[DESCRIPTOR[fiIters]]]] ! 

NSFile.Error => CONTINUE]; 

NSFile.Close[parentFhi NSFile.Error =>CONTINUE]; 

IF bootFH = NSFile.nullHandle THEN RETURN; 

[bootFile, specialBootf irstPage] «• NSSegmentlnternal .GetID[bootFH] ; 

TemporaryBooting.MakeBootab 1 e[ 

bootFile, specialBootfIrstPage ! TemporaryBooting.InvalidParameters => GOTO invalid]; 

RETURNfTRUE]; 

EXITS invalid => RETURN; 

END; -- FindQuickRestartBootfile 

HardwareDependentBootfile: PROCEDURE RETURNS[name: NSStrlng.String] ={ 
name *■ NSStrlng. nullString; 

name «- SELECT ProcessorFaceExtras .Version[] .machineType FROM 
dandelion => dllonname, 
kiku => klkuname, 

ENDCASE => dovename; 

}’ 

GotResources: PUBLIC PROCEDURE[otherVolume: Volume.ID] RETURNS f800LEAN] = 

BEGIN 

margin: CARDINAL = 150; 
standalone: BOOLEAN *■ Standalone[] : 

volume: Volume.ID *■ IF otherVolume=Volume. nul 1 ID THEN Vol ume. systemID ELSE otherVolume; 
temp: LONG INTEGER; 

available: LONG INTEGER «- Volume .GetAttributes[vol ume] . f reePageCount: 
temp *■ available - fileSize: 

IF temp <mergln THEN ERROR SpaceError[requestedPage: fileSize+mergin, aval 1ablePage: available]: --fix AR18053 
IF -standalone THEN 

IF -FindQuickRestartBootfi1e[] THEN ERROR Error[restartBootFileNotFound]: 

RE.TURN[TRUE] ; 

END; -- GotResources 


Dolt: PUBLIC PROCEDURE [otherVolume: Volume.ID] = 

BEGIN 

currentPriority; Process.Priority; 

helper: PROCESS; 

hel perDone: BOOLEAN «- FALSE; 

Standalone: BOOLEAN «• Standalone[]; 

file: File.File; flrstPage: File.PageNumber; 

Helper: PROC » BEGIN UNTIL helperDone DO Process.Yield; ENDLOOP; END; 

-- Find Bootfile from Volume.systemID. 

--$$$ KLUDGE: To stop other process during Saving, I run the my process Pr1ority 2 ProcessPriorities.prlorltyPageFaultLow and Fork 
another process which will stop every other client activity so that any other process<0,1,2) will not write to disk. 

-- wait for the black out display.(unless strage thing happens) 

Process.Pause[t1cks: Process.SecondsToTlcks[l]]; 
currentPriority «- Process .GetPrior1ty[] ; 

Process.SetPriorityfProcessPriorities.priorityPageFaultLow]; 
helper «■ FORK He1per[]; 

IF ~MakeOutLoadFile[] THEN RETURN; 

-- page 0 will be used for Information 

[] «- KernelFile.MakeBootable[outloadFi1e, PowerOffRestartlnternal.firstPage, fileSize]; 

-- We want to get all of the work that we possbily can done BEFORE we do the OutLoad. wdk 
IF Snapshot.OutLoad[outloadFile, PowerOffRestartlnternal.firstPage] THEN { 

- just booted outload 

SetOutloaded[out: FALSE, otherVolume: otherVolume]; -- do this first thing upon return from Outload. wdk 
IF outloadFile ft Fi le . nul 1 Fil e THEN { 

DeleteOutLoad[]; 

reset physical volume boot from User volume. 
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e 


IF -standalone THEN { 

[file, firstPage] «- GetVolumeBootF11e[Volume . systemID] ; 

TemporaryBooting.Instal1 PhysicalVolumeBootFile[ file, firstPage]}; 

» 

ELSE 1 

-- just wrote outload 

SetOutloaded[out: TRUE, otherVolume: otherVolume]; -- guess we've got to do this after OutLoad wdk 
IF -standalone THEN 

TemporaryBoot1ng.Install PhysicalVolumeBootF11e[bootFile.special Bootf1rstPage ]; 

ProcessorFace.PowerOff[]; 

-- (can't get here) wdk 

}: 

join helper process 
holperDone *• TRUE; 

JOIN helper; 

set priority to foreground(Note that you ned to change this if the Notlfier chage Priority 
Process.SetPriority[currentPriority]; 

END; -- of SaveOutLoad 

MakeOutLoadFile: PROCEDURE RETURNS[BOOLEAN] = 

BEGIN 

outloadFIle *■ File.Create[ 

Volume.systemID, flleSIze+l, PowerOffRestartlnternal.outloadFileTypelVolume.InsufficientSpace, Volume.Readonly => 
Volume.InsertRootF11e[ 

type; PowerOffRestartlnternal.outloadFileType, file: outloadFilelVolume.RootDirectoryError => CONTINUE]; 
RETURN[TRUE]; 

EXITS error => RETURN[FALSE]; 

END; 


SotOutloaded; PROC [out: BOOLEAN, otherVolume: Volume.ID] = { 

outLoaded: PowerOffRestartlnternal.CheckHandle = Space.Map[[outloadFile. 0, 1]].pointer; 

outLoaded . val id «■ out; 

IF out THEN { 

IF otherVolume # Volume.nullID THEN outLoaded.lastWrlteOateinScavengeVolume «- SpecialVolume.LastOpenedForWrite[ 
otherVolume]; 

outLoaded . lastNetworkNumber *■ Courier.LocalSystemElement[] . net; 
outLoaded . 1 astWriteDateinUserVolume «■ SpecialVolume . LastOpenedForWrite[ 

Volume.systemID] ; 

[] «- Space .CopyOut[outLoaded , [outloadFi le , 0, 1]]; 

[] «• Space .Unmap[outLoaded] 

}: 

GetVolumeBootFile; PROC [IvID: Volume.ID] 

RETURNS [file: File.File, firstPage; File.PageNumber] = 

BEGIN 

bootFiles; Boot.LVBootFiles; 

SpecialVolume.GetLogicalVolumeBootFiles[lvID, @bootF11es]; 

IF bootFiles[pilot].fID.filelD = File.nullID THEN RETURN[File.null File, 0] 

ELSE { 

file <- [bootFiles[pi 1 ot] .fID.filelD, 1 vID] : 

RETURN[f11e , bootFiles[pilot].firstPage]}; 

END; 

Standalone: PROC RETURNS[BOOLEAN] ={ 

saEnabled: BOOLEAN *• ProductFactoring. Enabled [VPPFOptions. vpStandal one] ; 
rEnabled: BOOLEAN *• ProductFactoring. Enabled [VPPFOptions.vpRemoteCom]; 
nEnabled: BOOLEAN *■ ProductFactoring , Enabled [VPPFOptions .vpNetCom] ; 

IF nEnabled THEN RETURN[FALSE]; -- network is strong. 

IF saEnabled OR rEnabled OR 

{(nEnabled AND rEnabled AND saEnabled) AND System.switches [ 1 U] s down) OR 

((-nEnabled AND -rEnabled AND -saEnabled) AND System.switches [’U] = down) THEN R£TURN[TRUE] ELSE RETURN[FALSE]}; 
-- Make sure Outload file deleted at boot time 


DeleteOutLoad[]; 

--Temporaly Proc for BWS4.3g should be deleted for 8WS4.3h 
DeleteBootFile[]; 


END. 
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Created. 

Fix workstation fook to different network move problem. 
Support Application Folder Power Off Quick Restart 
Support Device dependent check. 

18053: To minimiza user confusion 


GOTO error]; 


-- Standalone 
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File: PowerOffRestartlnternal .mesa - last edit: 
— M1ta.es 17-Feb~87 17:08:58 


Copyright (C) 1987 by Xerox Corporation. All rights reserved. 

— OVERVIEW: 

-- This Is containd internal definition and File type which is used for Power off Quick Restart capability 


DIRECTORY 

File USING [PageNumber, Type], 

System USING [GreenwichMeanTime, NetworkNumber]; 

PowerOffRestartlnternal: DEFINITIONS = 

BEGIN 

CheckHandle: TYPE = LONG POINTER TO CheckRec; 

CheckRec: TYPE = MACHINE DEPENDENT RECORD [ 
valid(O): BOOLEAN, 

1 astWriteDateinUserVolume(I): System.GreenwichMeanTIme, 
l8.stWr1teDateinScavengeVolume(3): System.GreenwichMeanTime , 
lastNetworkNumber(5): System.NetworkNumber]; 

-- IN FlleTypes.VersatecFileType 

-- I use this to make compatible with Versatec Workstation 
outloadF11eType: File.Type = [10078]; 

f lrstPage: FI 1e.PageNumber = 1; -- We use page 0 for special info. 


END. 

17-F‘eb-87 17:08:53 Mita Created. 

13-Oct-87 11:31:48 Mita Add 1astNetworkNumber to fix change Workstation to different net . 
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-- File: PowerOffRestartlmpl.mesa - last edit: 

-- Mita.ES 18-Feb-88 14:43:46 

-- Copyright (C) 1987, 1988 by Xerox Corporation. All rights reserved. 

-- OVERVIEW: PowerOffRestartlmpl which actually manage a OutLoad file in USer volume. Throught the PowerOffRestart interface you can 
access anything. 

--Note Outload file will be deleted automatically when the 1ogonCompleted. 

« OVERALL DESIGN COMMENTS: wdk 

Make the swap check file and the outload file both be ***temporary** files. This has the wonderful property that, if some other agent 
opens the volume for write, the files that we don't want to use anyway will be deleted automatically! Nice. [Picture of Dale patting 
self on back.] 

o Simplifying Idea. Make swap check file and inload file all be one file. The swap check data is page zero, the inload part starts at 
page one. This means less code to manage files. 

o When creating and deleting files etc, be very careful of the order of operations so that a crash does not leave orphan files on the 
disk. Put comments in the code noting the required order e.g. 

xxx; -- 1 of 3 

xxx; -- 2 of 3 

xxx; -- 3 of 3 

o This program should not know the name of the "user" volume. Its main volume Is Volume.systemID and the optional otherVolume parameter 
I mentioned in my proposed new interface. 

o If QuickRestartClientlmpl does a normal boot, it should first delete all files that this module created. 

>> 


This procesdure has the KLUDGE, find by this pattern. 


DIRECTORY 

ApplicationFolder USING [FromName], 

Boot. USING [LVBootFiles]. 

BootFile USING [maxEntriesPerHeader, maxEntriesPerTrai1er. 

MemorySizeToFileSize], 

BWSFileTypes USING [systemFileCatalog]. 

Catalog USING [Open], 

Courier. 

Environment USING [PageNumber], 

File USING [ 

Create, Delete. File. nullID, nullFile, PageNumber. Type, 

Unknown], 

KernelFile USING [MakeBootable], 

NSFile, 

NSSegmentlnternal USING [GetID], 

NSString, 

Process USING [GetPriority, Pause. Priority, SecondsToTicks. SetPriority. Yield], 

ProcessorFace USING [PowerOff], 

ProcessorFaceExtras USING [Version], 

ProcessPriorities USING [priorityPageFaultLow], 

Snapshot USING [OutLoad], 

Space USING [CopyOut, Map. Unmap], 

SpecialSpace USING [reaIMemorySize], 

SpecialVolume USING [LastOpenedForWrite. GetLogicalVolumeBootF iles], 

PowerOffRestart, 

PowerOffRestartlnternal, 

ProductFactoring, 

System, 

FemporaryBooting USING [ 

InstallPhysicalVolumeBootFile, InvalidParameters, MakeBootab 1e], 

VPPFOptions, 

Volume USING [ GetAttributes, ID. InsufficientSpace. InsertRootFi1e, LookUpRootFi1e, nullID, Readonly, RemoveRootFile, 

RootDirectoryError, systemID], 

XString; 

PowerOffRestartlmpl: PROGRAM 
IMPORTS 

ApplicationFolder, BootFile, Catalog, Courier, File, NSSegmentlnternal, Process, 

ProcessorFace. ProcessorFaceExtras, ProductFactoring, Snapshot, Space. SpecialSpace. SpecialVolume. System, Volume, KernelFile. 
NSFile, NSString, TemporaryBooting, XString 
EXPORTS PowerOffRestart - 
BEGIN 

specialBootf irstPage: F i 1 e. PageNumber «- 1; -- We use page 0 for special info. 

dlionname: NSString .String «■ NSStrlng.StrlngFromMesaString["QuickRestartDl ion .boof'G]; 
dovename: NSString . String «■ NSString .StringFromMesaString["Qu ickRestartDove . boof'G] : 
klkuname: NSString .String «• NSString. StringFromMesaString["Qu i ckRestartKi ku . boof’G] ; 

SpaceError: PUBLIC ERROR [requestedPage: Environment.PageNumber, availablePage: Environment.PageNumber] - CODE; 

Error: PUBLIC ERROR [type: PowerOffRestart.ErrorType] ; CODE: 


outloadFile; File.File <- File.nullFile: 
bootFile: File.File; 

flleSize: LONG CARDINAL <- BootFi 1 e.MemorySizeToFi 1 eSize[ 
SpecialSpace.reaIMemorySize]; 

DeleteOutLoad: PROC = 

BEGIN 

outloadFile «- Volume.LookUpRootFile[ 

PowerOffRestartlnternal.outloadFileType, Volume.systemID ' 
Volume.RootDirectoryError => CONTINUE]; 

IF outloadFile tf File. nullFile THEN { 
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--need to delete file first, then remove from directory. Otherwise, crash would orphan the file, [insert comment explaining why order 
important.] wdk 

File.Delete[outloadFile ! File.Unknown => CONTINUE]; 

Volume.RemoveRootFi1e[ 

PowerOffRestartlnternal.outloadFi1eType. Volume.systemID ! 

Volume.RootDirectoryError => CONTINUE]; 

}: 

END; --DeleteOutLoad 

DeleteBootFile: PROC = 

BEGIN 

--Teraporaly Proc for BWS4.3g 

parentFh: NS F i le .Handle *■ Catalog .Open[BWSFil eTypes . systemFi 1 eCatal og] ; 
bootFH ; NSFile.Handle «- NSFile. nul IHandle ; 
filters: ARRAY [0..1) OF NSFile.Filter «- [ 

[matches[[name[NSString.StringFromMe$aString["QuickRestart*-boot"L]]]]]]; 
bootFH <- NSFile.Find[ 

directory: parentFh, scope: [filter: [and[DESCRIPTOR[fi1ters]]]] ! 

NSFile.Error => CONTINUE]; 

TF bootFH = NSFile.nullHandle THEN RETURN; 

NSFile.Delete[bootFHl 
. NSFile.Error => CONTINUE]; 

END; --DeleteBootFile 

FindQuickRestartBootfile: PROC [] RETURNS [BOOLEAN <- FALSE] = 

BEGIN 

parentFh: NSFile.Handle *• NSF i 1 e . null Handl e ; 

i nterna 1 NameRB : XString .ReaderBody «- XString . FromSTRING["Power Off Quick Restart"L]; 
appl icationfolder: NSFile .Reference <- NSFile . nul IReference : 
bootFH: NSFi le.Handle «■ NSFi le. nul IHandle; 
filters: ARRAY [0..1) OF NSFi 1 e. F11 ter «- [ 

[matches[[ nanie[HardwareDependentBootf ile[]]]]]]; 
appl icat ion folder «• Appl icationFolder. FromName[@ internal NameRB]: 

IF applicationfolder=NSFile.nullReference THEN RETURN; 

parentFh *■ NSF i 1 e .OpenByReference[appl icat ionfol der! NSF i 1 e. Error : > CONTINUE]; 

IF parentFh=NSFile.nulIHandle THEN RETURN: 
bootFH <- NSFile.Find[ 

directory: parentFh, scope: [filter: [and[DESCRIPTOR[fi1ters]]]] ! 

NSFile.Error => CONTINUE]; 

NSFile.Close[parentFh! NSFile.Error = CONTINUE]; 

IF bootFH = NSFile.nullHandle THEN RETURN: 

[bootFIle, specia 1 BootfirstPage] «- NSSegmentlnterna 1 .GetID[bootFH] ; 

TemporaryBooting.MakeBootable[ 

bootFile, specialBootfirstPage ! TemporaryBooting.InvalidParameters => GOTO invalid]; 

RETURN[TRUE]; 

EXITS invalid => RETURN; 

END; -- FindQuickRestartBootfile 

HardwareDependentBootfi1e: PROCEDURE RETURNS[name: NSString.String] ={ 
name *■ NSString . nu 11 String; 

name «- SELECT ProcessorFaceExtras. Version[] .machinefype FROM 
dandelion => dlionname, 
kiku => kikuname, 

ENDCASE => dovename: 

}; 

GotResources: PUBLIC PROCEDURE[otherVolume: Volume.ID] RETURNS [BOOIEAN] = 

BEGIN 

mergin: CARDINAL = 150; 
standalone: BOOLEAN «- Standalone[]; 

volume: Volume.ID <- IF otherVolume=Volume . null ID THEN Vol ume . systemID ELSE otherVolume; 
temp: LONG INTEGER; 

available: LONG INTEGER *■ Volume.GetAttributes[vo1 ume] .freePageCount; 
temp «- available - fileSlze; 

IF temp <merqin THEN ERROR SpaceErrorfrequestedPaqe: f ileSize+mergln, availablePage: available]; --fix AR18053 
IF -standalone THEN 

IF ~FindQuickRestartBootfile[] THEN ERROR Error[restartBootFi1eNotFound]; 

RETURN[TRUE]; 

END; -- GotResources 

Dolt: PUBLIC PROCEDURE [otherVolume: Volume.ID] = 

BEGIN 

currentPriority: Process.Priority; 

helper: PROCESS; 

he IperDone : BOOLEAN <- FALSE; 

standalone: BOOLEAN +■ Standalone[]; 

file: File.File; firstPage: File.PageNumber; 

Helper: PROC - BEGIN UNTIL helperDone 00 Process .Yield; ENDLOOP; END; 

-- Find Bootfile from Volume.systemID. 

--$$$ KLUDGE: To stop other process during Saving. I run the my process Priority=ProcessPriorities.priorityPageFaultLow and Fork 
another process which will stop every other client activity so that any other process(0,l,2) will not write to disk. 

-- wait for the black out display.(unless strage thing happens) 

Process.Pause[ticks; Process.SecondsToTlck$[l]] ; 
currentPriority «- Process .GetPriority[] ; 

Process.SetPriority[ProcessPriorities.priorityPagePaultLow]; 
helper *■ FORK Helper[]; 

IF "MakeOutLoadFi1e[] THEN RETURN; 

-- page 0 will be used for Information 

[] ♦* KernelFile.MakeBootable[outloadFile, PowerOf fRestartlnternal . fi rstPage, fileSlze]; 

-- We want to get all of the work that we possbily can done BEFORE we do the OutLoad. wdk 
IF Snapshot.OutLoad[outloadFi1e, PowerOffRestartlnterna1.firstPage ] THEN { 

-- just booted outload 

SetOutloaded[out: FALSE, otherVolume: otherVolume]: do this first thing upon return from Outload. wdk 

IF outloadFile » File.nullFile THEN { 

DeleteOutLoad[]; 

-- reset physical volume boot from User volume. 
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IF -standalone THEN { 

[file, firstPage] +- GetVolumeBootFile[Volume.systemID]; 

TemporaryBooting.Instal1 PhysicalVo 1umeBootFi1e[ file, firstPage]}: 

}} 

ELSE { 

-- just wrote outload 

SetOutloaded[out: TRUE, otherVolume: otherVolume]; -- guess we've got to do this after OutLoad wdk 
IF -standalone THEN 

TemporaryBooting.Instal1 PhysicalVolumeBootFi1e[bootFile,specialBootfirstPage ]; 

ProcessorFace.PowerOff[]; 

-- (can't get here) wdk 

}; 

-- join helper process 
helperDone «- TRUE; 

JOIN helper; 

-- set priority to foreground(Note that you ned to change this if the Notifier chage Priority 
Process,SetPriority[currentPriority]; 

END; -- of SaveOutLoad 

MakeOutLoadFile: PROCEDURE RETURNS[BOOLEAN] = 

BEGIN 

outloadFile «- File.Create[ 

Volume.systemID, fileSize+1, PowerOffRestartlnternal.outloadFileTypeIVolume.InsufficientSpace, Volume.Readonly -> 
Volume.InsertRootFile[ 

type: PowerOffRestartlnternal.outloadFileType, file: outloadFileIVolume.RootDlrectoryError => CONTINUE]; 

RETURN[TRUE]; 

EXITS error => RETURN[FALSE]; 

END; 


SetOutloaded: PROC [out: BOOLEAN, otherVolume: Volume.ID] = { 

outLoaded: PowerOffRestartlnternal.CheckHandle = Space.Map[[outloadFi1e, 0, 1]].pointer; 

outLoaded.val id *■ out; 

IF out THEN { 

IF otherVolume ft Volume. nul 1 ID THEN outLoaded . 1 astWri teDatei nScavengeVolume *- SpecialVolume . LastOpenedForWri te[ 
otherVolume]; 

outLoaded. lastNetworkNumber <- Courier. LocalSystemElement[] . net; 
outLoaded. lastWriteOateinUserVolume «- SpecialVolume. LastOpenedForWrite[ 

Volume,systemID]; 

[] <- Space .CopyOut[outLoaded, [outloadFile, 0, 1]]; 

[] «- Space.Unmap[outLoaded] 

}; 


GetVolumeBootFile: PROC [IvID: Volume.ID] 

RETURNS [file: File.File, firstPage: Fi1e,PageNumber] = 

BEGIN 

bootFiles: Boot.LVBootFi1es; 

SpecialVolume.GetLogicalVolumeBootFi1es[1vID, GbootFiles]; 

IF bootFiles[pilot].fID.fileID - FIle.nullID THEN RETURN[Fi1e.nu11File . 0] 
ELSE { 

file *- [bootFiles[pilot]. fID.filelD, IvID]; 

RETURN[file, bootFiles[pi1ot].firstPage]} ; 

END: 


Standalone: PROC RETURNS[BOOLEAN] ={ 

saEnabled: BOOLEAN «- ProductFactoring.Enab led [VPPFOptions . vpStanda lone] ; 
rEnabled: BOOLEAN *• ProductFactoring.Enabled [VPPFOptions.vpRemoteCom]; 
nEnabled: BOOLEAN ProductFactoring . Enabled [VPPFOptions . vpNetCom] ; 

IF nEnabled THEN RETURN[FALSE]; -- network is strong. 

IF saEnabled OR rEnabled OR 

((nEnabled AND rEnabled AND saEnabled) AND System.switches ['U] - down) OR 

((-nEnabled AND -rEnabled AND -saEnabled) AND System.switches [’U] = down) THEN RETURN[TRUE] ELSE RETURN[FALSE]}; 
-- Make sure Outload file deleted at boot time 


DeleteOutLoad[]; 

--Temporaly Proc for BWS4.3g should be deleted for BWS4.3h 
DeleteBootFile[]; 


END. 
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GOTO error]; 


-- Standalone 



-- File: PowerOffRestartlnternal.mesa - last edit: 

— Mita.es 17-Feb-87 17:08:58 

Copyright (C) 1987 by Xerox Corporation. All rights reserved. 

-- OVERVIEW: 

-- This is containd internal definition and File type which is used for Power off Quick Restart capability 


DIRECTORY 

File USING [PageNumber, Type], 

System USING [GreenwichMeanTIme, NetworkNumber]; 

PowerOffRestartlnternal: DEFINITIONS = 

BEGIN 

CheckHandle: TYPE = LONG POINTER TO CheckRec; 

CheckRec: TYPE = MACHINE DEPENDENT RECORD [ 
valld(O); BOOLEAN. 

lastWri teDatei nUserVo lume( 1): System.GreenwichMeanTime . 

1 astWriteDatei nSc avenge Volume (3): Systeni .G reenwi chMeanT ime, 
lastNetworkNumber(5): System.NetworkNumber] *, 

-- IN FileTypes.VersatecFileType 

-- 1 use this to make compatible with Versatec Workstation 
outloadFileType: File.Type = [10078]; 

firstPage: File.PageNumber = 1; -- We use page 0 for special info. 


END. 

17-Feb-87 17:08:53 Mita Created. 

13-0ct-87 11:31:48 Mita Add lastNetworkNumber to fix change Workstation to different net 
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-- File: QuickRestartCIientlmpl.mesa - last edit: 
-- Mita 27-Jan-88 14:15:09 

-- Breisacher 21-0ct-87 9:40:58 


-- Copyright (C) 1987, 1988 by Xerox Corporation. All rights reserved. 

DIRECTORY 

Boot USING [LVBootFiles], 

File USING [Delete. File, nullFile, Unknown], 

LevelIVKeys USING [KeyBits, KeyName], 

NSConstants, 

Space USING [Copyln, ScratchMap, Unmap], 

String USING [Equivalent], 

SpecialVolume USING [GetLogicalVolumeBootFi1es, LastOpenedForWrite. OpenVolume]. 

OthelloOps USING [GetTimeFromTimeServer, SetProcessorTime, TimeServerError], 

PhysicalVolume USING [ 

AssertPllotVolume, Error, GetHandle, GetNextDrive, Handle, ID, 

NeedsScavenging, nullDevicelndex, nullID], 

PilotMP USING [cScavenging, cDiskHardwareError, cTimeNotAvai1 able, cClient], 

ProcessorFace USING [SetMP], 

PowerOffRestartlnternal USING [CheckHandle, outloadFileType, firstPage], 

Router USING [FindDestinationRelativeNetlD], 

Scavenger USING [Scavenge], 

System USING [GreenwichMeanTime, LocalTimeParameters. NetworkNumber, nulINetworkNumber, SetLocalTimeParameters]. 

TemporaryBooting USING [BootFromFile, BootFromVolume. Instal1PhysicalVolumeBootFi1e. InvalidParameters], 

UserTerminal USING [WaitForScanLine, keyboard], 

Volume USING [GetNext, GetLabelString, ID, maxNameLength, NeedsScavenging, nullID, 

LookUpRootFile, Open, RootDirectoryError, Unknown]: 

Ou ickRestartClientlmpl: PROGRAM 
IMPORTS 

File, OthelloOps, PhysicalVolume, ProcessorFace. Router, Scavenger. Space, SpecialVolume, String, 

System, TemporaryBooting, UserTerminal. Volume = 

BEGIN 

userVolume: Volume.ID *■ Volume.nul 1 ID; 

CheckOutloadOK: PROC [volumeName: LONG STRING] 

RETURNS [inload: File.File, proceed: BOOLEAN] = 

BEGIN 

outloadFile: File.File «■ F i 1 e . nul 1F i 1 e ; 
userVolume *• GetVo1umeID[vo lumeName]; 
proceed «- FALSE: 

IF userVolume ft Vol ume . nul 1 ID THEN { 

Special Volume.OpenVolume[userVolume, read(Volume.NeedsScavenging = > [LogicalVolumeScavenge[userVolume]: CONTINUE}]; delete 
because this is permanent. 
outloadFile *• Vol ume. LookUpRootF i 1 e[ 

PowerOffRestartlnternaI.outioadFi1eType, userVolumeiVolume.RootDirectoryError => GOTO Errors]: 

IF outloadFile ft Fi le . nul 1 Fi le THEN { 

check: PowerOffRestartlnternal.CheckHandle = Space.ScratchMap} t]: 
proceed *• CheckOutloaded[outloadFi le . check ! Fi le .Unknown = > GOTO Errors]: 

IF proceed THEN proceed *■ (check. lastNetworkNumber - System. nul 1 NetworkNumber) OR (LocalNet[] - check. 1 astNetworkNumber); 
inload «■ outloadFile: 

[] *- Space .Unmap[check]}; 

}: 

EXITS Errors -> {proceed «- FALSE; RETURN}; 

END; 

Log icalVoiumeScavenge: PROC [volume: Volume.ID] = 

BEGIN 

scavengerlog: File.File: 

ProcessorFace.SetMP[PilotMP.cScavenging]; 

scavengerlog <- Scavenger.Scavenge[volume, volume, safeRepair. FALSE]; 

Volume.Open[volume]; 

File.De1ete[scavengerlog]; 

ProcessorFace.SetMP[Pi1otMP.cClient]; 

END; 


CheckOutloaded: PROC [file: File.File, check: PowerOffRestartlnternal.CheckHandle] 
RETURNS [out: BOOLEAN] = { 

scavengerVolume: Volume. ID GetVolumeID[ , 'Scavenger"L]: 

[1 «- Space .CopyIn[check, [file, 0, 1]]; 
out «- check.valid AND 

(check.lastWriteDateinUserVolume - SpecialVolume.LastOpenedForWrite[ 
userVoIume]) 

AND 

(check.lastWriteDateinScavengeVolume = SpecialVolume.LastOpenedForWrite[ 
scavengerVolume])}; 

GetVolumelD: PROC [svVolume: LONG STRING] RETURNS [vl: Volume.ID] = 

BEGIN 

svLabel: STRING = [Volume.maxNameLength]; 
v I *■ Volume .nullID; 

UNTIL (vl *■ Volume.GetNext[vl ]) = Volume . nul 11D DO 
Volume.GetLabelString[vl, svLabel]; 

IF String.EquivalentfsvVolume, svLabel] THEN EXIT: 

ENDLOOP; 

END; -- of GetVolumelD 

LocalNet: PROC RETURNS [System.NetworkNumber] = { 

RETURN[Router. F indDestinationRe1 ativeNetID[System.nulINetworkNumber]]; 

}: 

Run: PROCEDURE 
BEGIN 
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userVolName: LONG STRING «- "User"L; 
timeFromServer: BOOLEAN *■ TRUE; 
dolnload: BOOLEAN «- TRUE; 
time: System.GreenwIchMeanTime; 

1tps: System.LocalTimeParameters; 
inloadFile: File.File; 

ProcessorFace.SetMP[Pi1otMP.cTimeNotAvail able]; 

[time, Itps] *■ Othelloops.GetTimeFromTimeServer[ 

! OthelloOps.TimeServerError => RETRY]; 

IF timeFromServer THEN { 

System.SetLocalTimeParameter$[1tps]; OthelloOps.SetProcessorTime[time]}; 

-- If there is no Time server boot from scratch, 
dolnload «- timeFromServer; 

IF dolnload THEN dolnload «■ BringFirstReadyPhysicalVolumeOnl ine[]; 

IF ~doInload THEN -- Can not Online Volume 

{ProcessorFace.SetMP[PilotMP.cDiskHardwareError]; RETURN} 

ELSE (FOR i:CARDINAL IN[0..5) DO UserTerminal,WaitForScanLine[0]; 
dolnload «• ~KeysAreDown[keyl: N, key2: B]; 

IF "dolnload THEN EXIT; 

ENDLOQP; 

IF dolnload THEN [inloadFile, dolnload] <• CheckOutloadOK[userVo1Name]; 

IF dolnload THEN [] «- TemporaryBooting.BootFromFile[ 

inloadFile, PowerOffRestartInternal.firstPage’TemporaryBooting.InvalidParameters. Volume.Unknown, File.Unknown, 
Volume .NeedsScavenging => (dolnload <■ FALSE; CONTINUE}]; 

-- "only returns if couldn't inload" WDK 

IF userVolume=Volume.nul1 ID THEN userVolume *- GetVolumeID["User"L]; 

SetPhysicaIBoot fuserVolumel; 

1emporarybooting.BootFromVolume[userVolume] 

END; — Run 

KsysAreDown: PROCEDURE [keyl, key2: LevelIVKeys.KeyName] RETURNS [BOOLEAN] - { 
keys: LONG POINTER TO LevelIVKeys.KeyBits = LOOPHOLE[UserTerminal.keyboard]; 

RE.TURN[( keys[keyl] = down) AND (keys[key2] = down)]; 

}: 

BringFirstReadyPhysicalVolumeOnline: PROC RETURNS [BOOLEAN] - 
BEGIN 

drivelndex: CARDINAL «- PhysicalVolume .nul 1 Devicelndex ; 
driveHandle: PhysicalVolume.Handle; 
pvID; PhysicalVolume.ID; 


DO -- loop looking for drives connected to this machine 
pvID «• Phys ical Vo lume . null ID: 

drivelndex «■ Physical Volume .GetNextDrive[dri velndex]; 

IF drivelndex = Physical Volume.nulIDevicelndex THEN EXIT; 
driveHandle *■ PhysicalVolume .GetHandle[driveIndex]; 

IF TRUE <<PhysicalVolume.IsReady[driveHandle]>> THEN 
BEGIN 

<<IsReady doesn't work properly. Thus the following code is necessary.>> 
pvID *r PhysicalVolume.AssertPilotVolume[ 
driveHandle ! 

PhysicalVolume.Error, PhysicalVolume.NeedsScavenging => CONTINUE]; 

IF pvID = Physical Volume.nul1 ID THEN EXIT; 

RETURN[TRUE]; 

END; 

ENOLOOP; -- end of loop until a drive is selected 
RETURN[FALSE]; 

END; -- of BringFirstReadyPhysicalVolumeOnl ine 


SetPhysicalBoot: PROCEDURE [lvID: Volume.ID] = { 
bootFiles: Boot.LVBootFiles; 

SpecialVolume.GetLogicalVolumeBootFi1es[1vID, ©bootFi1es]; 

Volume.Open[lvID!Volume.NeedsScavenging=> (LogicalVolumeScavenge[1vIDJ; CONTINUE;}]; 
TemporaryBooting.InstallPhysicalVolumeBootFi1e [ 
file; [bootF i 1es[pi1ot].fID.fi1elD. IvID], 
firstPage; bootFiles[pilot].firstPage]; 

}: 

--Main 
Run[]; 
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- Create from QuickBoot hack. 

- Support Time service 

- Incorporate suggestion from D KNUTSEN(.various clean up) 

- N B = Normal Boot 

- Catch signal File.Unknown fo r checkoutloadOK 

- DO not crash when user select NB 

- AR14143 Fix. 

- If workstation is moved to a different net while powered off, we now detect that and do a normal boot. 
Set physical volume boot back to User volume if we don't do the inload. 

- AR17622: The workstation is not booted as normal by "N" and M B" keys. To fix this, 
will do scavenge User volume, see LogicalVolumeScavenge . 


I fix the 915 problem I 


2 


QuickRestartClientlmpl.mesa 


27-Jan-88 14:15:10 PST 



-- Copyright (C) 1983, 1987 by Xerox Corporation. All rights reserved. 

--- Boot.mesa 8-Oct-87 12:22:07 by CAJ 

--- This module defines TYPEs and constants used for invoking the Germ and passing parameters to It. It also has constants used for 
building Germs. 

Since the initial microcode is the primeval invoker of the germ, many of the items defined here are known to the initial microcode: 
thus changes to this interfaces will require corresponding changes to the initial microcode. 

DIRECTORY 

BootFile USING [InLoadMode, MDSIndex], 

Device USING [Type], 

Environment USING [Long, PageCount, PageNumber], 

HostNumbers USING [HostNumber, nullHostNumber]. 

PilotDisk USING [FilelD, FilePageNumber, nullFilelD], 

PIlotDIskFace USING [DiskAddress]. 

PrincOps USING [ControlLink], 

SDDefs USING [sBoot, SD, sFirstGermRequest. sGermCount .sLastPilot ■-], 

StartList USING [Base], 

System USING [defaultSwitches. NetworkAddress, Switches], 

Volume USING [Type]; 

Boot: DEFINITIONS = 

BEGIN 

-- SOME ITEMS DEFINED HERE ARE KNOWN TO THE INITIAL MICROCODE. CHANGING THEM WILL REQUIRE CORRESPONDING CHANGES TO IT. 

—,-,— Attributes of the Germ: --— 

mdsiGerm: BootFi1e.MDSIndex = 0; 

-- the MDS of the Germ, as defned in the PrincOps. Known to the initial microcode. 
pageGerm: Environment.PageNumber = 1; 

Page where Germ's image starts (within Germ's MDS). Known to the initial microcode. 

countGermVM: Environment.PageCount = 96 - pageGerm; 

-- Amount of virtual memory reserved for Germ and its buffers. 


- -Arguments for the Germ, and returned results: ~~— -- 

-- Version numbers for the format of a Request: 

currentRequestBasicVersion: CARDINAL - 3456B; 

currentRequestExtensionVersion: CARDINAL = 7654B; 

Request: TYPE - MACHINE DEPENDENT RECORD [ 

Basic portion of Request: (format known by the initial microcode) 

-- tF YOU CHANGE THE FORMAT OF THIS PORTION, YOU MUST INCREMENT currentRequestBasicVersion AND GENERATE NEW INITIAL MICROCODE! 
requestBasicVersion (OB): CARDINAL «- currentRequestBasicVersion, 
action (IB): Action, 
location (2B): Location, 

switches (16B): System.Switches «■ System.defaultSwitches, -- When calling OutLoad, these are the default switches to be used for 

system when InLoaded later. When calling InLoad, these are switches to be used for system being InLoaded; defauItSwitches means use 
the ones built into the boot file. When returning from InLoad, these are the switches passed from caller of InLoad or, if he passed 
defaultSwitches. the switches built into the boot file. 

-- Extension portion of Request: (not used by the initial microcode) 
requestExtensionVersion (15B): CARDINAL +■ currentRequestExtensionVersion. 

-- Extensions for InLoad - "results": 

pStartListHeader (36B): StartList.Base, only valid after inload of virgin boot file. 

Extensions for OutLoad - "arguments": 
inLoadMode (40B): 8ootF11e.InLoadMode. - real page numbers significant? 

As a side-effect of the cross-mds call mechanism, the entry point of the system being outLoaded is stored in plnitialLinkt in the 
caller’s mds and the mds of the system being outLoaded is passed to the Germ. 

-- Extensions for OutLoad - "results": 

session (41B): Session ]; -- just finished OutLoad, or InLoaded later? 


Action: TYPE = MACHINE DEPENDENT RECORD [act(O): CARDINAL]; 
inLoad: Action = [0]; 

-- restore volatile processor state from BootFile format snapshot, 
outl.oad: Action = [1]; 

-- save volatile processor state in BootFile-format snapshot. 
bootPhysicalVolume: Action = [2]: 

-- do inLoad using Location specified indirectly in pilot entry of PVBootFiles array of physical volume root page of disk specified by 
accompanying Location. Value known by the initial microcode. 

teledebug: Action = [3]; 

-- speak to Ethernet as Teledebug Server. Return when commanded to. 
noOp: Action = [4J; -- simply enter and exit the Germ. 

Session: TYPE = [continuingAfterOutLoad, newSession}; 


Location: TYPE = MACHINE DEPENDENT RECORD [ format known by the initial microcode. 
-- Description of boot file location: 

deviceType (0): Device.Type, - e.g. sa4000. ethernet 
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deviceOrdinal (1): CARDINAL, -- position of device within all those of same type 
vp (2): SELECT OVERLAID * FROM 

disk => [diskFilelD (2): DiskFilelD], 

ethernetOne = > [bootFileNumber (2): CARDINAL, net (3), host (4): CARDINAL «■ 0], 
ethernet => [ethernetRequest (2): EthernetRequest], 

any => [a (2), b (3), c (4), d (5), e (6). f (7). g (10B), h {1 LB): UNSPECIFIED], 
ENDCASE]; 


--- Disk Location Data: 

DiskFilelD: TYPE = MACHINE DEPENDENT RECORD [ 
fID (0): PilotDIsk.FilelD, 
firstPage (5): PilotDisk.FilePageNumber, 
da (7): PilotDIskFace.DiskAddress]; 

Convention: a DiskFilelD is null if its fID is null: 

NulIDiskFilelD: PROCEDURE [diskFilelD: DiskFilelD] RETURNS [BOOLEAN] = INLINE 
{ RETURN[diskFi1elD.fID = Pi1otDisk.nul1FiIelD] }; 

bootPhysicalVolumeDiskAddress: PilotDiskFace.DiskAddress = LOOPHOL£[LONG[0]]; 

— (It would be cleaner if this was defined using PilotDiskFace.) 

DiskBootChainLink: TYPE = PilotOiskFace.DiskAddress: 

riui IDiskBootChainLink: DiskBootChainLink = LOOPHOLE[LONG[0]] ; 

-- This Is written in the boot chain link field of all 

but the last page of each disk run of the bootable portion of a file. 

-- A valid disk address is written in the last page of each interior disk run 
of the bootable portion of a file. 

eofDiskBootChainLink: DiskBootChainLink = LOOPHOLE[LAST[LONG CARDINAL]]: 

-- "End of file". This must be written in the boot chain link field of the last 
page of the bootable portion of a file which is loaded by the microcode 
(hard microcode, soft microcode, diagnostic microcode, germ). 

It is required to delimit the end of the file to the microcode. 

DiskAddress: TYPE = Pi1otDiskFace.DiskAddress: -- for compatibility. 


-- Ethernet Location Data: 

EthernetRequest: TYPE = MACHINE DEPENDENT RECORD [ 

bfn(O): EthernetBootFileNumber, addres$(3): System.NetworkAddress]: 

EthernetBootFileNumber: TYPE = RECORD [HostNumbers.HostNumber] ; 

-- Ethernet boot file numbers are allocated from the same name space as 
-- HostNumbers. Of course, these numbers do not represent hosts. 

nullEthernetBootFileNumber: EthernetBootFileNumber = [HostNumbers.nulIHostNumber]; 


----Booting information for the Germ and microcode:-- 

-- Types of boot files pointed to from root pages of physical and logical 
-- volumes, and delivered by boot servers: 

-- The following cannot be changed without invalidating all Pilot volumes. 

-- Known to the initial microcode. 

BootFileType: TYPE = MACHINE DEPENDENTf 

hardMicrocode (0), softMicrocode (1), germ (2), pilot (3), debugger (4), 
debuggee (5)}: 

PVBootFiles: TYPE - ARRAY BootFileType [hardMicrocode..pilot] Of DiskFilelD; 
-- format known to the initial microcode. 

LVBootFlles: TYPE = ARRAY BootFileType OF DiskFilelD; 

VolumeType: TYPE = Volume.Type: -- for compatibility. 


--—~—~~ Reserved Memory Locations for the Germ and Pilot: —~—-- 

plnitialLink: indirect PrincOps.ControlL ink - 

The entry point to the system (the Germ or Pilot) which is rooted 
-- in the MDS containing plnitialLink. Is automatically set as a 
-- side-effect of the cross-mds linkage mechanism. 

-- plnitialLink* itself is a control link within the mds containing it. 

- NOTE: The value of plnitialLink is defined by the PrincOps. 

[ indirect[link[link: LQOPHOLE[ LOOPHOLE [ SDDe fs . SD, CARDINAL] +- 

SDDefs.sBoot * SIZE[LONG UNSPECIFIED]], fill: 0]]]; 

Previous replaces following until compiler, broken in 11.1, is again 
able to handle expressions of "@externalConstantAddress[constantOffset]" 
- [indirect[1ink[link: L00PH0LE[6SDDef s.SD[SDDef $.sBoot]] , fill; 0]]]; 

<< TEMP omitted until compiler can evaluate constant pointer expressions 
at compile time. 

initialLinkAlignedRight: PRIVATE BOOLEAN[TRUE..TRUE] = 

(LOOPHOLE[pInitialLink, PrincOps.Control Link].indirect AND 
NOT LOQPHOLEfpInitialLink, PrincOps.Control Link].proc ); >> 

pCountGerm: LONG POINTER TO CARDINAL = 

-- The number of pages occupied by the germ. Set by MakeBoot. 

- This data is allocated in the Germ’s MDS. 

-- Excludes dynamically allocated pages (buffers, etc). 

-- Location known to initial microcode. 
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LOOPMGLE[ Environment.Long[ any[ 

low: LOOPHOLE[SDDefS.SO, CARDINAL]+$DDefs.sGermCount*SIZE[LONG UNSPECIFIED], 
high: mdsIGerm]]]; 

-- Previous replaces following for same reason as above. 

-~LOOPHOL£[ Environment.Long[ any[ 

low: ©SDDefs.SD[SDDef$.sGermCount], high: mdsiGerm]]]; 

pRequest: LONG POINTER TO Request = 

-- The job to be done by the Germ. 

- This data is allocated in the Germ's MDS. 

-- NOTE: pRequest and the address of pRequest*.action and pRequest*.location 
-- are known by the initial microcode, and MesaNetExec. 

LOOPHOLE[ Environment.Long[ any[ 

low: LOOPHOLE[SDDefs.SD. CARDINAL] + SDDefs.sFirstGermRequest 
* SIZE[LONG UNSPECIFIED], high: mdsiGerm]]]; 

- Previous replaces following for same reason as above. 

--LOOPHOLE[ Environment.Long[ any[ 

low: ©SDDefs.SD[SDDefs.sFirstGermRequest], high: mdsiGerm]]]; 

-- (The allocation of SD[sFirstPi1ot] .. SD[sLastPi1ot] is defined in GermOps.) 
END. 


LOG 

September 13, 1979 6:03 PM PXM Create file 

January 26, 1980 4:22 PM PXM 

Add bootPhysicalVolume and noOp Request’s and ethernet Location 
January 25, 1980 6:37 PM PXM 

Replace Location.device with Location.deviceType and .deviceOrdinal 
April 17, 1980 12:41 AM FXH Added teledebug 

April 17, 1980 10:39 AM AWL Added net and host to Location.ethernet 

July 15, 1980 10:09 PM FXH Add NoOp; refer to Volume.Type 

11- Aug 81 15:26:19 AWL 

Location.ethernet => Location.ethernetOne. Added Location.ethernet forr 10MB ethernet. 

Made ReadMDS an INLINE. 

13-Aug-81 15:28:05 WDK 

Switches prepended to Request; address decremented 20B to 13408. 

Un-loopholed plnitialLink. Added pCrossMdsFrames and assertions. 

Made more machine dependent. 

21- Aug-81 8:51:40 WDK 

plnitialLink changed to be an indirect ControlLink. 

22- Oct-81 12:04:31 WDK 

New instruction set and SDDefs. Changed value of plnitialLink and pRequest. Moved mdsiGerm, countSkip. pCountGerm, here from BootSwap 
and made most LONG. Added pageGerm, countGermVM, currentVersions, bootPhysicalVolumeDiskAddress. Improved documentation. 

5-0ct-82 10:05:45 AWL 

Modified DiskFilelD to use PilotDisk.FilelD and not File.ID. 

12- Nov-82 11:59:00 LXD 

DIskAddress changed from opaque type to PilotDisk.Address. 

28-Mar-83 15:33:43 WDK 

..and thence to PilotDiskFace.DiskAddress (which is what it actually is). Added EthernetRequest. BootServerPacket. and 
EthernetBootFileNumber. Made Location.ethernet use them. Added DiskBootChainLink, etc. 

5-Apr-83 18:00:47 WDK Moved BootServerPacket to BootServerDefs. 

B-Jul-83 13:22:36 WDK 

Added nullEthernetBootFileNumber. Made compatible with new PrincOps, SDDefs. Remove compiler bug workarounds. 

8-Oct-87 12:21:08 CAJ 

Changed constant in coungGermVM from 64 to 96. As a result, changed currentRequestExtensionVersion from 7123B to 7654B. Altered 
plnitialLink, pCountGerm, and pRequest to form compiler will process. 
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- BootUserlmpI.mesa 
-- 17-Apr-89 12:37:45 

-- Copyright (c) 1989 by Xerox Corporation. All rights reserved. 

DIRECTORY 

Exec USING [AddCommand, ExecProc, RemoveCommand], 

OthelloToolDefs USING [Run], 

Process USING [Abort], 

Runtime USING [GetBcdTime], 

String USING [AppendString], 

Time USING [Append, Unpack], 

Tool USING [Create, Destroy, MakeSWsProc, MakeTTYSW, UnusedLogName], 

TooIWIndow USING [Activate, TransitionProcType], 

TTY USING [Handle], 

TTYSW USING [GetTTYHandle], 

Version USING [Append], 

Volume USING [Close, ID, systemID], 

Window USING [Handle]: 

OthelloToolImpl: PROGRAM 
IMPORTS 

Exec, Runtime, String, OthelloToolDefs, Process, Time, 

Tool, ToolWindow, TTYSW, Version, Volume 
EXPORTS OthelloToolDefs = { 

tty: PUBLIC TTY.Handle: 

toolWIndow: Window.Handle: 

Commandlnterpreter: PROCESS; 

Inlt: PROCEDURE = [ 
name: LONG STRING «• [75]; 
name.length <- 0; 

String.AppendString[name, "OthelloTool "L]; 

Version.Append[name]; 

String.AppendString[name," of "L]; 

Time.Append[name.Time,Unpack[Runtime.GetBcdTime[]]]; 
toolWindow <- Tool.Create[ 

name: name, makeSWsProc: MakeTTYSW, clientTransition: Stop, 
cmSection: "OthelloTool"L, tinyNamel: "Othello"L, tinyName2: "TooV'L]; 

Exec.AddCommand[name: "OthelloTooI,~"L . proc: Activate, unload: DestroyTool] 

}: 


Stop: ToolWindow.TransitionProcType s [ 
IF new = inactive THEN { 

Process.Abort[CommandInterpreter]; 
JOIN Commandlnterpreter;}; 

}; 


Activate: Exec.ExecProc = (ToolWindow.Activate[toolWindow]; 

DestroyTool: Exec.ExecProc = ( 

Exec.RemoveCommand[h, "OthelloTool.~"L]; 

Tool.Destroy[toolWindow]; 


MakeTTYSW: Tool.MakeSWsProc = ( 
logName: LONG STRING <- [20]; 
ttySW: Window.Handle; 
logName . length «- 0; 

Tool.UnusedLogName[unused:logName, root: "OthelloTool.1og"L]; 
ttySW <- Tool .MakeTTYSW[window :window, name: 1 ogName] ; 
tty «■ TTYSW.GetTTYHandle[ttySW] ; 

Commandlnterpreter *■ FORK Othel loToolDefs .Run[]; 


CloseVolume: PUBLIC PROCEDURE[volume: Volume.ID] = [ 

IF volume ¥ Volume.systemID THEN Volume.Close[volume];}: 
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-- BootUserlmplA.mesa 
-- 1.7-Apr-89 16:19:55 

-- Copyright (c) 1989 by Xerox Corporation. All rights reserved. 

DIRECTORY 

OthelloDefs USING [ 

AbortingCommand, CloseFetch, CommandProcessor. Confirm, GetName, 

IndexTooLarge, LeaderPage, leaderPages, IpVersion, MyNamels, NewLine. 
PaekedTimeFromString, Question, ReadMumber, RegisterCommandProc, 

SetCommandString, WriteChar. WriteFixedWidthNumber, WriteLine, 

WriteLongNumber. WriteOctal, WriteString, Yes], 

OthelloOps USING [ 

BadSwitches, BootFileType , OecodeSwitches, DeleteTempFiles, GetDriveSize, 
GetNextSubVolume, GetPhysicalVolumeBootFile , GetSwitches, GetVolumeBootFile, 
nul1SubVotume, SetDebugger, SetDebuggerSuccess, SetExpirationDate, 
SetExpirationDateSuccess, SetGetSwitchesSuccess, SetPhysicalVolumeBootFile. 
SetSwitches, SubVolume, VoidPhysicalVolumeBootFile. VoidVolumeBootFile], 

OthelloToolDefs USING [CloseVolume], 

SpecialVolume USING [OpenVolume], 

TemporaryBooting USING [BootButton], 

Volume USING [ 

Erase, GetAttributes, GetLabelString, Ge.tType, ID, 

NeedsScavenging, NotOnline, nullID, Open. systemID, Type], 

VolumelnitlniplA: PROGRAM 
IMPORTS 

File, Heap, Inline, OthelloDefs. OthelloOps, OthelloToolDefs, PhysicalVolume, Process, 
Scavenger, Space, SpecialVolume. System, String, TemporaryBooting, Volume, 
VolumeVersion 
EXPORTS OthelloDefs 
SHARES File = 

BEGIN OPEN OthelloOps, OthelloDefs: 

Quit: PROC = (TemporaryBooting.BootButton[]}: 

SetPvBoot: PROC = 

BEGIN 

IvID: Volume.ID «- GetLvIDFromUser[] . 1 vID; 

SpecialVolume,OpenVolume[lvID, read]: 

FOR t: BootFileType IN [softMicrocode..pi lot] DO 

IF GetVolumeBootFilepvID, t].file ft File.nul 1 FI 1 e THEN { 
file: File.File: 
firstPage: File . PageNumber; 

[file, firstPage] «- GetVolumeBootFIle[lvID, t]; 

SetPhysicalVolumeBootFIle[fi1e, t, firstPage]}; 

ENDLOOP; 

Othel!oToolDefs.CloseVolume[lvID]; 

END; 

GetUserLvID: PROC [] RETURNS [IvID: Volume.ID] = 

BEGIN 

DO 

ptmpID: PhysicalVolume.ID *■ PhysicalVolume . nul 1 ID; 

inputstring: LONG STRING «■ "User"; 
matches: CARDINAL *■ 0; 

DO 

driveTemp: PhysicalVolume.Handle; 

ItmpID: Volume. ID *■ Vo I ume . nu 11 ID; 

IF (ptmpID *■ PhysicalVolume. GetNext[ptmpID]) = PhysicalVolume .nul 1 ID THEN EXIT; 
driveTemp *■ PhysicalVolume .GetAttri butes[ptmpID j. instance ; 

DO 

s: STRING = [maxNameLength]; 

IF (ItmpID <- PhysicalVolume .GetNextLogica IVolume[ptmpID . ItmpID]) 

= Volume.nullID THEN EXIT: 

GetLogicalVolumeNameptmpID, s ! Volume .NotOnJ ine => LOOP]; 

IF FunnyEqual[driveTemp, s, inputstring] THEN ( 
matches «- matches + 1; IvID «- ItmpID; pvID «■ ptmpID; drive driveTemp}; 
ENDLOOP: 

ENDLOOP; 

SELECT matches FROM 

0 => WriteString["Not found\r"L]: 

1 => RETURN; 

ENDCASE -> Wr IteL ine["Ambigous; please specify Dev ice:LogicalName"L]; 

ENDLOOP; 

END; 


GetL.ogicalVolumeName; PROC [vid: Volume. ID, s: STRING] = { 
s. 1 ength *■ 0 ; 

Volume,GetLabelStrlng[vid, s ! Volume.NeedsScavenging => GOTO bad]; 
EXITS bad => ( 

IDRep: TYPE = RECORD [p; ARRAY [0..3) OF CARDINAL, n: LONG CARDINAL]; 
String.AppendString[s, "NeedsScaveng ing"L]; 

String.AppendLongNumber[s, LOOPHOLE[vid, IDRep].n, 8]}}; 


Ge.tl.vIDFromUser: PUBLIC PROC [ 
prompt: LONG STRING *■ NIL, 
cal ledFromSetDebuggerPtrs : BOOLEAN FALSE] 

RETURNS [ 

pvID: Physica1Vo1ume.ID, IvID: Volume.ID, 
drive: PhysicalVolume.Handle] = 

BEGIN 

IF prompt = NIL THEN prompt «* "Logical Volume Name: "L; 
DO 

ptmpID: PhysicalVolume . ID *■ Phys icalVolume . null ID: 


Runtime, 
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inputstring: LONG STRING; 
matches: CARDINAL *- 0; 

GetNarae[ 

prompt: prompt, how: echo, signalQuestion: TRUE, 
dest: IF calledFromSetDebuggerPtrs THEN ©debuggerLogicalString 
ELSE ©inputLogicalString 
! Question => {ListLogicalVoIumes[]; RESUME}]; 

IF calledFromSetDebuggerPtrs THEN { 

IF debuggerLogicalString.length=0 THEN {IvID «■ Volume.nul 1 ID; RETURN} 

ELSE inputstring *■ debuggerLogicalString) 

ELSE {Inputstring «■ inputLogicalString}; 

DO 

driveTemp: Physical Volume.Handle; 

ItmpID: Volume.ID *■ Volume. null ID; 

IF (ptmpID *- PhysicalVolume.GetNext[ptmpID]) = PhysicalVolume. nul 1 ID THEN EXIT 
driveTemp «- PhysicalVolume.GetAttributes[ptmpID]. instance; 

DO 

s: STRING - [maxNameLength]; 

IF (ItmpID *■ PhysicalVolume.GetNextLogicalVolume[ptmpID, ItmpID]) 

= Volume.null ID THEN EXIT; 

GetLoglcalVolumeName[ltmpID, s ! Volume.NotOnline r > LOOP]; 

IF FunnyEqual[driveTemp, s, inputstring] THEN { 
matches «• matches + 1; IvID «■ ItmpID; pvID *■ ptmpID: drive *■ driveTemp}; 
ENDLOOP; 

ENDLOOP; 

SELECT matches FROM 

0 => WriteString["Not found\r"L]; 
l => RETURN; 

ENDCASE => WriteLine["Ambigous; please specify Device:LogicalNarae"L]; 

FNDLOOP; 

END; 


FunnyEqual: PROC [h: PhysicalVolume.Handle. name: STRING, userName: LONG STRING] 
RETURNS[BOOLEAN] = { 

SameChar: PROC [a, b: CHARACTER] 

RETURNS [BOOLEAN] = { 

IF a=b THEN RETURN[TRUE] 

ELSE IF a IN ['a..'z] AND b IN [’A.^Z] AND (a-’a+'A)=b THEN RETURN[TRU£] 
ELSE IF a IN [*A..'Z] AND b IN ['a..'z] AND (a-’A+*a)=b THEN RETURN[TRU£] 
ELSE RETURN[FALSE]}; 


IF String.Equivalent[name, userName] THEN RETURN[TRUE]; 

FOR i: CARDINAL IN [0..driveName.1ength) DO 

IF ~SameChar[dr1veName[i], userName[1]] THEN RETURN[FALSE] ENDLOOP; 

IF driveName . length+name . length+1 ft userName . length THEN RETURN[FALSE]; 

IF userName[driveNan>e. length] ft ’: THEN RETURN[FALSE]; 

FOR i: CARDINAL IN [0..name.1ength) DO 

IF ~SameChar[name[i], userName[driveName.1ength+l+i]] THEN RETURN[FALSE] 
ENDLOOP; 

RI:TURN[TRUE]}; 


END 
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File: HexConvertToolImpl .mesa - last edit: 

— Cooper.-OSBU North.-Xerox 25-Nov-88 13:56:03 

— MManley 18-Feb-85 23:13:57 

— Copyright (C) 1988 by Xerox Corporation. All rights reserved. 

DIRECTORY 

Ascii USING [CR. SP], 

Environment USING [Byte], 

Event USING [DoneWIthProcess, Handle, StartingProcess, toolWindow], 

EventTypes USING [deactivate], 

Exec USING [AddCommand, ExecProc, RemoveCommand], 

FormSW USING [A1locateltemDescriptor, Booleanltem, ClientltemsProcType, 
Commandltem, ItemHandle, UneO, llnel, 11ne2, ProcType, Strlngltera], 

Heap USING [Create, Delete], 

Inline USING [BITAND, BITOR, BITSHIFT], 

MFno USING [Type], 

MStream USING [Error, GetLength, Readonly, SetLength, WriteOnly], 

Process USING [Detach], 

Put USING [Line, Text], 

Runtime USING [GetBcdTime], 

Stream USING [Delete, EndOfStream, GetChar, GetByte, Handle. PutByte, PutChar, 
PutString], 

String USING [AppendStrlng], 

Supervisor USING [AddDependency, AgentProcedure, CreateSubsystem, 
EnumeratlonAborted, RemoveDependency, SubsystemHandle] , 

T1a»e USING [Append, AppendCurrent, Unpack], 

Tool USING [Create, Destroy, MakeFIleSW, MakeFormSW, MakeMsgSW, MakeSWsProc, 
UnusedLogName], 

ToolWindow USING [Activate, GetState, TransItlonProcType], 

Window USING [GetChlld, GetParent, Handle, Stack, ValidateTree]: 

HexConvertToolImpl: PROGRAM 

IMPORTS Event, Exec, FormSW, Heap, Inline, MStream, Process, Put, 

Runtime, Stream, String, Supervisor, Time, Tool, ToolWindow, Window 

BEGIN 


-- Types 


Formlndex: TYPE * {protectBln, binFIls, protectHex, hexFIle, blnToHex, 
hexToBln}: 

Tool Data: TYPE 3 MACHINE DEPENDENT RECORD [ 
msgSW(O): Window.Handle +■ NIL, 
formSW(2): Window.Handle «• NIL, 
logSW(4): Window.Handle «- NIL, 
protectB1n(6): BOOLEAN <* TRUE, 
protectHex(7): BOOLEAN <■ TRUE, 
b1nF11eName(8): LONG STRING *• NIL, 
hexF 11eNani9( 10): LONG STRING *■ NIL, 
commandIsRunn1ng( 12): BOOLEAN «■ FALSE]; 


— Constants 


agent: Supervisor.SubsystemHandle = Supervisor.CreateSubsystem[CheckDeact1vate]; 


-- Globals 


data: LONG POINTER TO ToolData «■ NIL; 
wh: Window.Handle *■ NIL: 
heap: UNCOUNTED ZONE <- NIL; 


-- Initialisation 


Inlt: PROC = 

BEGIN 

Exec.AddCommand["HexConvertTool ,~"L, MakeTool , NIL, Unload]; 

END; — Inlt 

MakeTool: Exec.ExecProc 3 
BEGIN 

IF wh = NIL THEN 
BEGIN 

name: LONG STRING «■ [60]; 

String.AppendString[to : name, from : "Hex Convert Tool 3.0 of "L]; 
Time .Append[s: name, unpacked: Time.Unpack[Runt1me.GetBcdTime[]]]; 
name.length <- name.length - 3; — lop the seconds 
wh <- Tool .Create[name: name, makeSWsProc: MakeSWs, 

cllentTransitlon: Cllenttransltlon, cmSection: "HexConvertTooV'L, 
tinyNamel: "Hex"L, t1nyName2: "Converf'L]; 

END 

ELSE IF ToolWindow.GetState[wh] = active THEN 
BEGIN 

newSlbllng: W1ndow.Hand!e = Window.GetCh11d[W1ndow.GetParent[wh]]; 
IF wh # newSlbllng THEN { 

Window.Stack[wh, newSlbllng]; Window.ValidateTree[wh]}; 

END 

ELSE 
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ToolWIndow.Act1vate[wh]; 

EKD; — MakeTool 

Unload: Exec.ExecProc = 

BEGIN 

IF wh # NIL THEN {Tool.Destroy[wh]; wh <- NIL}; 
Exec.RemoveCommand[h, "HexConvehtTool.~"L]; 
END; — Unload 


-- State change 


CheckDeactlvate: Supervlsor.AgentProcedure 3 
BEGIN 

IF event = EventTypes.deactivate AND wh # NIL 
AND wh = eventData AND data.commandlsRunnlng THEN 
BEGIN 

Put.L1ne[data.msgSW, "Tool Is busy!"L]; 

ERROR Supervisor.EnumeratlonAborted; 

END; 

END; — CheckDeactlvate 

CllentTransItlon: ToolWIndow.TransItlonProcType = 

BEGIN 

SELECT TRUE FROM 
old = inactive E > 

BEGIN 

IF heap = NIL THEN heap «■ Heap .Create[1n1t1al ; 1, Increment: 1]; 

IF data = NIL THEN data «■ heap .NEW[ToolData <- []]; 

END; 

new = Inactive => 

BEGIN 

Supervisor.RemoveDependency[cllent: agent, Implementor: Event.toolWIndow] ; 
IF data # NIL THEN heap.FREE[©data]; 

IF heap # NIL THEN {Heap.Delete[heap]; heap «- NIL}; 

END; 

ENDCASE; 

END; -- CllentTransItlon 


-- Tool window 


MakeSWs: Tool.MakeSWsProc 3 

BEGIN 

logFIleName: STRING = [50]; 

Tool.UnusedLogName[unused: logFIleName, root: "HexConvertTool.log"L]; 

data.msgSW «- Tool .MakeMsgSW[w1ndow; window]; 

data.formSW <■ Tool .MakeFormSW[w1 ndow: window, formProc: MakeForm]; 

data.logSW *• Tool .MakeF11eSW[w1ndow: window, name: logFIleName]; 

Supervisor.AddDependency[client: agent, Implementor: Event.toolWIndow]; 

END; — MakeSWs 

MakeForm: FormSW.ClientltemsProcType 3 

BEGIN 

OPEN FormSW; 

nltems: CARDINAL = Formlndex.LAST.ORD + 1; 

Items *• A11 ocateItemDescr1ptor[nItems]; 

1tems[FormIndex.protectBIn .ORD] *• BooleanItem[ 
tag: "ProtectB1nary"L, place: [0, UneO], switch: ©data.protectBln]; 

1tems[FormIndex .blnFUe.ORD] «- Str1ngltem[ 
tag: "Binary F11e"L, place: [100, lineO], inHeap: TRUE, 
string: Qdata.blnFileName]; 

1tems[FormIndex .protectHex .ORD] <- BooleanItem[ 

tag: "ProtectHex"L, place: [0, llnel], switch: ©data.protectHex]; 

1tems[FormIndex.hexFIle.ORD] <- Str1ngltem[ 
tag: "Hex File"L, place: [100, llnel], inHeap: TRUE, 
string: ©data.hexFileName]; 

1tems[FormIndex.b1nToHex.0RD] * CommandItem[ 
tag: "Convert Binary To Hex"L, place: [0, 11ne2], proc: Convert]; 

1tems[FormIndex.hexToB1n.0RD] *■ CommandItem[ 

tag: "Convert Hex To B1nary"L, place: [200, line2], proc: Convert]; 

RETURN[Items: Items, freeDesc: TRUE]; 

END; -- MakeForm 


— Convert procs 


Convert: FormSW.ProcType 3 
BEGIN 

IF data.commandlsRunnlng THEN 

Put.L1ne[data.msgSW, "Tool Is bu$y!"L] 
ELSE 
BEGIN 

convertProc: PROC «■ SELECT Index FROM 
Formlndex.blnToHex.ORD => BlnToHex, 
Formlndex.hexToBln.ORD => HexToBin, 
ENDCASE => ERROR; 
data. commandlsRunnlng +■ TRUE; 

Process,Detach[FORK convertProc[]]; 
END; 

END; -- Convert 

BlnToHex: PROC = 

BEGIN 
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PutByteHex: PROC [byte: Envlronment.Byte] = 

BEGIN 

NlbbleToChar: PROC [n: CARDINAL] RETURNS [c: CHAR] = INLINE 
BEGIN 

c <- SELECT n FROM 

IN [0 . .9] => VAL[ORD['0] + n], 

IN [10..15] -> VAL[ORD[’A] + n - 10]. 

ENDCASE => ERROR: 

END; — NlbbleToChar 
Stream.PutChar[hexStream, 

NlbbleToChar[IniIne.BITSHIFT[Ini ine . BITAND[byte, OFOH], -4]]]; 

Stream.PutChar[hexStream. NlbbleToChar[IniIne.BITAND[byte , 0FH]j]j 
END; — PutByteHex 

blnStream, hexStream: Stream.Handle +■ NIL; 

handle: Event.Handle <■ Event,Start1ngProcess[''Hex Convert Tool Is runnlng"L]; 
blnStream ♦* MStream.ReadOnly[data.blnFIleName, [NIL, NIL] ! 

MStream.Error => CONTINUE]; 

IF blnStream = NIL THEN { 

CleanUp["F11e Not Available!\n"L, handle]; 

RETURN}; 

hexStream «- GetWrl teStream[data. hexF11 eName , -data.protectHex, text]; 

IF hexStream * NIL THEN { 

Stream.Delete[binStream]; 

CleanUp["Output file Is protected!\n"L, handle]: 

RETURN}; 

PutBoth[''Converting binary file ,M '"L]; 

PutBoth[data.blnFIleName]; 

PutBoth[ ,M ‘" to hex file ,M,,, L]; 

PutBoth[data.hexFIleName]; 

PutBoth[ ,,,, " ...”L]; 

WrlteHeader[hexStream]; 

DO 

ENABLE Stream.EndOfStream => EXIT; 

THROUGH [0 . . 8) DO 
THROUGH [0 .. 16) DO 

PutByteHex[Stream.GetByte[blnStream]]; 

PutByteHex[Stream,GetByte[binStream]]; 

Stream.PutChar[hexStream, Ascii.SP]; 

ENDLOOP; 

Stream.PutChar[hexStream, Ascii.CR]; 

ENDLOOP; 

Stream.PutChar[hexStream, Ascii .CR]; 

Stream.PutChar[hexStream, Ascii .CR]; 

ENDLOOP; 

Stream.PutChar[hexStream, AscI1.CR]; 

Stream.PutCharfhexStream, Ascii.CR]; 

Stream.Delete[b1nStream]; 

MStream.SetLength[hexStream, MStream.GetLength[hexStream]]; 

Stream.Delete[hexStream]; 

CleanUp[".. Done!\n"L, handle]; 

END; — BinToHex 

H.sxToBln: PROC = 

BEGIN 

PutNIbble: PROC [nibble: Environment.Byte] = 

BEGIN 

IF IsFIrstNIbble THEN 
fIrstNIbble nibble 

ELSE 

Stream.PutByte[b1nStream, 

Inline.BITOR[In1ine.BITSHIFT[fIrstNIbble , 4], nibble]]; 

IsFIrstNIbble *- -IsFIrstNIbble; 

END; — PutNIbble 

blnStream, hexStream: Stream.Handle «■ NIL; 

IsFIrstNIbble: BOOLEAN TRUE; 
flrstNIbble: Environment .Byte «• 0; 
char: CHARACTER; 

handle: Event.Handle * Event.Start1ngProcess["Hex Convert Tool Is runn1ng"L]; 
hexStream *■ MStream.ReadOnly[data.hexF11eName, [NIL, NIL] t 
MStream.Error => CONTINUE]; 

IF hexStream - NIL THEN { 

CleanUp["F11e Not Avallable!\n''L. handle]; 

RETURN}; 

blnStream «• GetWr1teStream[data.blnFIleName . -data.protectBln, binary]; 

IF blnStream - NIL THEN { 

Stream.Delete[hexStream]; 

CleanUp["Output file Is protected!\n"L, handle]; 

RETURN}; 

PutBoth["Convert1ng hexadecimal file """L]; 

PutBoth[data.hexFIleName] ; 

PutBoth[""" to binary file M ""L]; 

PutBoth[data.blnFIleName] ; 

PutBoth[""" ..."L]; 

DO 

BEGIN 

ENABLE Stream.EndOfStream *> EXIT; 
char <- Stream.GetChar[hexStream] ; 

SELECT char FROM 

IN ['a..*f] *> PutN1bble[char - ’a + 10]; 

IN [’A..'F] => PutNIbble[char - ’A + 10]; 

IN ['0..'9] *> PutNIbble[char - ’0]; 

Ascii.CR, Ascii.SP = > NULL; 

*> 

BEGIN 

IF Stream.GetChar[hexStream] * THEN 
UNTIL Stream.GetChar[hexStream] = Ascii.CR DO ENDLOOP 
ELSE 
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GOTO badHexChar; 

END; 

ENDCASE «> GOTO badHexChar; 

EXITS badHexChar => 

BEGIN 

Stream.Delete[hexStream]; 

MStream.SetLength[b1nStream, 0]; 

Stream.Delete[binStream]; 

CleanUp["Error: Non-hex character In binary file!\n"L, handle]; 

RETURN; 

END; 

END; 

EMDLOOP; 

IF -IsFIrstNIbble THEN { 

PutBoth["Warn1ng: Odd number of nibbles In hex fne! w L]; PutNibbl e[0]}; 
Stream.Delete[hexStream]; 

MStream.SetLength[bInStream, MStream.GetLength[bInStream]]; 

Stream,Delete[b1nStream]; 

CleanUp[".. Done!\n”L, handle]; 

END; — HexToBln 

GotWrlteStream: PROC [name: LONG STRING, overwrite: BOOLEAN, type: MFile.Type] 
RETURNS [stream: St ream. Handle «■ NIL] = 

BEGIN 

stream *• MStream.ReadOnly[name, [NIL, NIL] ! MStream.Error => CONTINUE]; 

IF stream » NIL THEN { 

Stream.Delete[stream] ; IF -overwrite THEN RETURN[NIL]}; 
stream *■ MStream.Wr1teOnly[name, [NIL, NIL], type]; 

END; — GetWrlteStream 

WriteHeader: PROC [stream: Stream.Handle] = 

BEGIN 

dateAndTIme: LONG STRING <• [40]; 

T1me.AppendCurrent[dateAndTIme, TRUE]; 

Stream.PutStr1ng[stream, File: "L]; 

Stream.PutStr1ng[stream, data.hexFIleName]; 

Stream.PutStr1ng[stream, "\n— From: "L]; 

Stream.PutStr1ng[stream, data.blnFIleName]; 

Stream.PutStr1ng[stream, "\n-- Date: "L]j 
Stream.PutStr1ng[stream, dateAndTIme]; 

Stream.PutStr1ng[stream, ”\n\n"L]; 

END; -- WriteHeader 

Cleanup: PROC [reason: LONG STRING, event: Event,Handle] = 

BEGIN 

PutBoth[reason]; 
data.commandlsRunnlng <- FALSE; 

Event.DoneW1thProcess[event]; 

END; -- Cleanup 

PutBoth: PROC [s: LONG STRING] = { 

Put.Text[data .msgSW, s’]; Put .Text[data. logSW, s]}; 


Mainline code 


Xn1t[]; 

END. . . 

LOG (Editor/Date/Comment): 

Mike Manley/10-Feb-84 20:26:52/Create program. 

Mike Manley/16-Aug-84 10:48:00/Converted to Mesa 11.0. 

Mike Manley/18-Feb-85 23:13:52/Converted to HexEdltTool. 

Martin Cooper/13-Nov-88 20:24:58/Converted to 14.0 & changed style. 
Martin Cooper/14-Nov-88 15:09:34/Rad1cal revamp of entire module. 
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— File: HexConvertToolImpl.mesa - last edit: 

— 3--Feb-89 22:01:39 

-- CoopenOSBU North:Xerox 25-Nov-88 13:56:03 

— MManley 18-Feb-85 23:13:57 

-- Copyright (C) 1988 by Xerox Corporation. All rights reserved. 

DIRECTORY 

Ascii USING [CR, SP], 

Environment USING [Byte], 

Event USING [DoneWIthProcess, Handle, StartlngProcess, toolWIndow], 

EventTypes USING [deactivate], 

Exec USING [AddCommand, ExecProc, RemoveCommand], 

FormSW USING [A1locateltemDescrlptor, Booleanltem, ClientltemsProcType, 
Commandltem, ItemHandle, UneO, llnel, 11ne2, ProcType, Strlngltem], 

Heap USING [Create, Delete], 

Inline USING [BITAND, BITSHIFT], 

MFIle USING [Type], 

MStream USING [Error, GetLength, Readonly, SetLength, WriteOnly], 

Process USING [Detach], 

Put USING [Line, Text], 

Runtime USING [GetBcdTIme], 

Stream USING [Delete, EndOfStream, GetChar, GetByte, Handle, PutByte, PutChar, 
PutStrlng], 

String USING [AppendStrlng, AppendLongDecimal], 

Supervisor USING [AddDependency, AgentProcedure, CreateSubsystem, 
EnumerationAborted, RemoveDependency, SubSystemHandle], 

Time USING [Append, AppendCurrent, Unpack], 

Tool USING [Create, Destroy, MakeFIleSW, MakeFormSW, MakeMsgSW, MakeSWsProc, 
UnusedLogName], 

ToolWIndow USING [Activate, GetState, TransltlonProcType], 

Window USING [GetChlld, GetParent, Handle, Stack, ValIdateTree]: 

HexConvertToolImpl: PROGRAM 

IMPORTS Event, Exec, FormSW, Heap, Inline, MStream, Process, Put, 

Runtime, Stream, String, Supervisor, Time, Tool, ToolWIndow, Window 

BEGIN 


-- Types 


Formlndex: TYPE = (protectBln, binFIle, protectHex, hexFIle, blnToHex, 
hexToBln}; 

ToolData: TYPE = MACHINE DEPENDENT RECORD [ 
msgSW(O): Window.Handle <- NIL, 
formSW(2): Window.Handle <■ NIL, 
logSW(4): Window.Handle «* NIL, 
prbtectB1n(6): BOOLEAN <- TRUE, 
protectHex(7): BOOLEAN f TRUE, 
b1nF11eName(8): LONG STRING <- NIL, 
hexFlleName(lO): LONG STRING <- NIL, 
commandlsRunn 1ng( 12): BOOLEAN *■ FALSE]; 


-- Constants 


agent: Supervisor.SubsystemHandle 3 Supervisor.CreateSubsystem[CheckDeact1vate] ; 


-- Globals 


data: LONG POINTER TO ToolData <- NIL; 
wh; W1 ndow. Hand la <- NIL; 
heap: UNCOUNTED ZONE * NIL; 


— Initialisation 


Inlt: PROC = 

BEGIN 

Exec.AddCommand["HexConvertTool.~"L, MakeTool, NIL, Unload]; 

END; — Inlt 

MakeTool: Exec.ExecProc = 

BEGIN 

IF wh = NIL THEN 
BEGIN 

name: LONG STRING «- [60]: 

String.AppendStr1ng[to: name, from : "Hex Convert Tool 3.0 of "L]s 
Time.Append[s: name, unpacked: Time.Unpack[Runt1me.GetBcdTime[]]]; 
name.length <• name.length - 3; -- lop the seconds 
wh * Tool.Create[name: name, makeSWsProc: MakeSWs, 

cllentTransItlon: CllentTransitlon, cmSectlon: "HexConvertTool"L, 
tlnyNamel: "Hqx"L, t1nyName2: "Convert"L]; 

END 

ELSE IF ToolWIndow.GetState[wh] = active THEN 
BEGIN 

newSIbling: Window.Handle = Window.GetCh1ld[W1ndow.GetParent[wh]]; 
IF wh ft newSIbling THEN { 

Window,Stack[wh, newSIbling]; Window.Val1dateTree[wh]}; 

END 
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ELSE 

ToolWIndow.Act1vate[wh]; 

END; — MakeTool 

Unload: Exec.ExecProc * 

BEGIN 

IF wh ft NIL THEN {Tool.Destroy[wh]; wh <- NIL}; 
Exec.RemoveCommand[h. "HexConvertTool.~ n L]; 
END; — Unload 


-- State change 


CheckDeactlvate: Supervisor.AgentProcedure = 

BEGIN 

IF event « EventTypes.deactivate AND wh ft NIL 
AND wh = eventData AND data.commandlsRunnlng THEN 
BEGIN 

Put.L1ne[data.msgSW, "Tool Is busy!"L]; 

ERROR Supervisor.EnumeratlonAborted; 

END; 

END; -- CheckDeactlvate 

CllentTransitlon: ToolWIndow.TransItlonProcType = 

BEGIN 

SELECT TRUE FROM 
old = Inactive => 

BEGIN 

IF heap = NIL THEN heap «■ Heap.Create[initial: 1, increment: 1]; 

If data = NIL THEN data <- heap.NEW[ToolData <- []]; 

END; 

new = Inactive => 

BEGIN 

Supervisor.RemoveDependency[c1lent: agent. Implementor: Event. toolWIndow] ; 
IF data ft NIL THEN heap.FREE[@data]; 

IF heap ft NIL THEN {Heap. Del ete[heap]; heap <• NIL}; 

END; 

ENDCASE; 

END; — CllentTransitlon 


— Tool window 


MakoSWs: Tool.MakeSWsProc * 

BEGIN 

logFIleName: STRING * [50]; 

Tool.UnusedLogName[unused; logFIleName, root: "HexConvertTool.log"L]; 

data.msgSW <- Tool .MakeMsgSW[w1 ndow: window]; 

data.formSW «• Tool ,MakeFormSW[w1ndow: window, formProc: MakeForm]; 

data.logSW *• Tool .MakeF 1 leSW[w1ndow: window, name: logFIleName]; 

Supervisor.AddDependency[cllent: agent, implementor: Event.toolWIndow]; 

END; -- MakeSWs 

MakeForm: FormSW.CllentltemsProcType 3 

BEGIN 

OPEN FormSW; 

nltems: CARDINAL = Formlndex.LAST.ORD + 1; 

Items *■ A11 ocateItemDescr1ptor[nItem$]; 

1t.ems[FormIndex.protectB1n.0RD] <- BooleanItem[ 

tag: "ProtectB1nary"L, place: [0, lineO], switch: @data.protectBln]; 

1t.ems[FormIndex .blnFIle.ORD] Str1ngltem[ 

tag: "Binary F11e"L, place: [100, lineO], InHeap: TRUE, 
string: Odata.blnFileName]; 

1tems[FormIndex.protectHex.ORD] <- BooleanItem[ 

tag: "ProtectHex"L, place: [0, llnel], switch: Qdata.protectHex]: 

1tems[FormIndex.hexFile.ORD] <- Stringltem[ 

tag: "Hex F11e"L, place: [100, llnel], InHeap: TRUE, 
string: Odata.hexFIleName]; 

1tems[FormIndex.b1rtToHex .ORD] *■ CommandItem[ 

tag; "Convert Binary To Hex"L, place: [0, 11ne2], proc: Convert]: 

1t.ems[FormIndex.hexToB1n.ORD] <■ CommandItem[ 

tag: "Convert Hex To B1nary"l, place: [200, 11ne2], proc: Convert]; 

RETURN[1tems: Items, freeDesc: TRUE]; 

END; -- MakeForm 


-- Convert procs 


Convert: FormSW.ProcType = 

BEGIN 

IF data.commandlsRunnlng THEN 

Put.L1ne[data.msgSW, "Tool Is busy!"L] 
ELSE 
BEGIN 

convertProc: PROC <- SELECT Index FROM 
Formlndex.blnToHex.ORD a > BlnToHex, 
Formlndex.hexToBln,ORD a > HexToBln, 
ENDCASE a > ERROR; 
data. commandlsRunnlng <- TRUE; 

Process.Detach[FORK convertProc[]]; 
END; 

END; — Convert 
BlnToHex: PROC = 
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* 


BEGIN 

PutByteHex: PROC [byte: Environment.Byte] = 

BEGIN 

NibbleToChar: PROC [n: CARDINAL] RETURNS [c: CHAR] = INLINE 
BEGIN 

c «■ SELECT n FROM 

IN [0. .7] => VAL[ORD['0] + n], 

ENDCASE => ERROR; 

END; — NibbleToChar 

Stream.PutChar[hexStream, N1bbleToChar[Inline.BITSHIFT[InlIne.BITAND[byte, 300B], -B]]]; 
Stream.PutChar[hexStream, N1bbleToChar[InlIne.BITSHIFT[InlIne.BITAND[byte, 070B], -3]]]; 
Stream.PutChar[hexStream, N1bbleToChar[In1ine.BITAND[byte. 0078]]]; 

END; -- PutByteHex 
wordCount: LONG INTEGER e 0; 
wordStrlng: LONG STRING * [20]; 
binStream, hexStream: Stream.Handle «- NIL; 

handle: Event.Handle *■ Event.StartlngProcess["Hex Convert Tool Is runn1ng"L]; 
binStream *• MStream.ReadOnly[data.b1nF11eName, [NIL, NIL] { 

MStream.Error => CONTINUE]; 

IF binStream = NIL THEN { 

CleanUp["F11e Not Ava11able!\n"L, handle]; 

RETURN}; 

hexStream «• GetWrlteStream[data.hexFlleName, ~data.protectHex, text]; 

IF hexStream = NIL THEN { 

Stream.De1ete[binStream]; 

CleanUp["Output file Is protected!\n"L, handle]; 

RETURN}; 

PutBoth[”Convert1ng binary file """L]; 

PutBoth[data.binFIleName]; 

PutBoth[ ,,,,,, to hex file .L]; 

PutBoth[data.hexFlleName]; 

PutBoth["’"' .,,"L]; 

Wr1teHeader[hexStream]; 

Stream.PutStr1ng[hexStream, "\n-- "L]; 

St.rlng.AppendLongDecImal[wordStrlng, wordCount] ; 

Stream,PutStr1ng[hexStream, wordStrlng]; 

Stream.PutChar[hexStream, Ascii.CR]: 

Stream.PutChar[hexStream, Ascii.CR]; 

DO 

ENABLE Stream.EndOfStream => EXIT; 

THROUGH [0. . 10) DO 
THROUGH [0 .. 10) DO 

PutByteHex[Stream.GetByte[binStream]]; 

Stream.PutChar[hexStream, '.]; 

PutByteHex[Stream.GetByte[b1nStream]]; 

Stream.PutChar[hexStream, Ascii.SP]; 

Stream.PutChar[hexStream, Ascii.SP]; 

ENDLOOP; 

Stream.PutChar[hexStream, Asd1.CR]; 

ENDLOOP; 

wordCount <- wordCount + 50; 

Stream.Put$tr1ng[hexStream, "\n\n-- *L]; 
wordStrlng . length «■ 0; 

String,AppendLongDecImal[wordStrlng, wordCount]; 

Stream.PutStr1ng[hexStream, wordStrlng]; 

Stream.PutChar[hexStream, Ascii.CR]; 

Stream.PutChar[hexStream, Ascii.CR]; 

ENDLOOP; 

Stream.PutChar[hexStream, Ascii.CR] ; 

Stream.PutChar[hexStream, Ascl 1.CR]; 

St ream.Delete[bInStream]; 

MStream.SetLength[hexStream, MStream.GetLength[hexStream]]; 

Stream.Delete[hexStream]; 

CleanUp[".. Done!\n"L, handle]; 

END; — BlnToHex 

HoxToBln: PROC = 

BEGIN 

binStream, hexStream: Stream.Hand!e *■ NIL; 
byte: Environment.Byte * 0; 
count: INTEGER *■ 0; 
char: CHARACTER; 

handle: Event.Handle «■ Event.Start1ngProcess["Hex Convert Tool is running"!.]; 
hexStream «- MStream.ReadOnly[data .hexFlleName, [NIL, NIL] ! 

MStream.Error => CONTINUE]; 

IF hexStream = NIL THEN { 

CleanUp["F11e Not Ava11ablel\n"L, handle]; 

RETURN}; 

binStream GetWr1teStream[data .binFIleName, -data.protectBln, binary]; 

IF binStream - NIL THEN { 

Stream.Delete[hexStream]; 

CleanUp["Output file Is protected!\n”L, handle]; 

RETURN}; 

PutBoth["Convert1ng hexadecimal file '"’"L]; 

PutBoth[data.hexFlleName]; 

PutBoth[""" to binary file ,,,M, L]; 

PutBoth[data.binFIleName]; 

PutBoth[""" ..."L]; 

DO 

BEGIN 

ENABLE Stream.EndOfStream «> EXIT; 
char «- Stream .GetChar[hexStream] ; 

SELECT char FROM 
IN [’0. . ’7] => { 

byte <- byte * 8 + char - ’0; 

IF (count «• count + 1) = 3 THEN { 

Stream.PutByte[b1nStream, byte]; 
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byte «• 0; 
count «■ 0; 

}: 

}; 

Ascll.CR, Ascii.SP, ■> NULL; 

•- *> 

BEGIN 

If Stream.GetChar[hexStream] = •- THEN 

UNTIL Stream.GetChar[hexStream] = Ascll.CR DO ENDLOOP 
ELSE 

GOTO badHexChar; 

END; 

ENDCASE => GOTO badHexChar; 

EXITS badHexChar -> 

BEGIN 

Stream.Delete[hexStream]; 

MStream.SetLength[b1nStream, 0]; 

Stream.Delete[b1nStream]; 

CleanUp["Error: Non-hex character In binary file!\n"L, handle]; 

RETURN; 

END; 

END; 

ENDLOOP; 

Stream.Delete[hexStream]; 

MStream.SetLength[b1nStream, MStream.GetLength[b1nStream]]; 

Stream.Delete[b1nStreain]; 

CleanUp[".. Done!\n"L, handle]; 

END; — HexToBln 

GetWrlteStream: PROC [name: LONG STRING, overwrite: BOOLEAN, type: MFIle.Type] 
RETURNS [stream: Stream .Handle «■ NIL] = 

BEGIN 

stream *• MStream.ReadOnly[name, [NIL, NIL] ! MStream.Error 3 > CONTINUE]; 

IF stream # NIL THEN { 

Stream.Delete[$tream]; IF -overwrite THEN RETURN[NIL]}; 
stream MStream.WrlteOnly[name. [NIL, NIL], type]; 

END; — GetWrlteStream 

WrlteHeader; PROC [stream: Stream.Hand!e] = 

BEGIN 

dateAndTIme: LONG STRING <- [40] ; 

Time.AppendCurrent[dateAndTIme, TRUE]; 

Stream.PutStr1ng[stream, "File: ”L]; 

Stream.PutStr1ng[stream, data.hexFIleName]; 

Stream.PutStr1ng[stream, "\n— From: ”L]; 

Stream.PutStrlng[stream, data.blnFI1eName]; 

Stream.PutStrlng[stream, "\n— Date: "L]; 

Stream.PutStr1ng[stream, dateAndTIme]; 

Stream.PutStrlng[stream, ”\n\n"L]; 

END; — WrlteHeader 

Cleanup: PROC [reason: LONG STRING, event: Event.Handle] a 
BEGIN 

PutBoth[reason]; 
data.commandlsRunnlng «• FALSE; 

Event.DoneW1thProcess[event]; 

END; — Cleanup 

PutBoth: PROC [s: LONG STRING] = { 

Put.Text[data.msgSW, s]; Put.Text[data.logSW, s]}; 


-- Mainline code 


In1t[]; 

END.. . 

LOG (Editor/Date/Comment): 

Mike Manley/10-Feb-84 20:26:52/Create program. 

Mike Manley/ie-Aug-84 10:48;00/Converted to Mesa 11.0. 

Mike Man1ey/18-Feb-85 23:13:52/Converted to HexEdltTool. 

Martin Cooper/13-Nov-88 20:24:58/Converted to 14.0 & changed style. 
Martin Cooper/14-Nov-88 15:09:34/Rad1cal revamp of entire module. 
Trow/ 3-Feb-89 10:46:27/10 words/line, 10 llnes/block. 
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*> 


«Fi le K4.mesa 

deL.aBeaujardiere:OSBU North : Xerox27-Apr-87 12:57:34 


>> 

DIRECTORY Ascii, Containee, FormWindow, 

NSFile, NSFileStream, NSString, 

PropertySheet, Prototype, StarWindowShell, Stream, 
Window, XString; 


K4; DEFINITIONS = 

BEGIN 

OPEN SWS: StarWindowShell; 


General Items: TYPE = {iconName, channel Speed, folderName, others}; 

Textltems: TYPE = (folderName, docName, 

justification, lineHeight, 
preLeading, postLeading, 
underl i n i ng , 

guessMark, dropKeepMark, 

pageBreak, 

others); 


Mapltems: TYPE 


(header, from, to}; 


Fontltems: TYPE = (fontO, 
f ontl , 
f ont2 , 
font3, 
f ont4, 
font5 , 
font6, 
font7, 
font8, 
font9, 


sizeO, 

italicsO, 

boldO, 

size 1, 

italics1, 

bold!. 

size2 , 

ital ics2, 

bold2, 

size3. 

italics3, 

bold3, 

s i ze4, 

italics4, 

bold4, 

size5, 

italics5, 

bold5, 

size6, 

italics6, 

bold6, 

size7, 

italics7, 

bol d7, 

size8, 

italics8, 

bol d8, 

size9, 

italics9, 

bold9} 


IconParms: 
IconParmsRecord: 
heap: 

propSheet: 
iconData: 
changeProc: 
changeProcData: 
iconFile: 
signature: 
genP rops: 
docProps: 
mapProps: 
fonProps: 


TYPE = LONG POINTER TO IconParmsRecord; 
TYPE = REC0RD[ 

UNCOUNTED ZONE <- NIL, 

SWS. Handle <- SWS. nul 1 Handl e, 

Contai nee . DataHandle <- NIL, 

Containee .ChangeProc «- NIL, 

LONG POINTER <- NIL, 

NSFi 1 e . Handle NSFi 1 e . nul lHandl e, 

CARDINAL <- 0, 

General Properties «- NIL, 
DocumentProperties <- NIL, 

MapProperties *■ NIL, 

FontProperties *- NIL]; 


ConvertParms: 
ConvertParmsRecord: 
zone : 

optionSheet: 
logFile: 
docProps: 
mapProps: 
fonProps: 


TYPE = LONG POINTER TO ConvertParmsRecord; 
TYPE = RECORD [ 

UNCOUNTED ZONE «- NIL, 

SWS.Handle <- SWS.nullHandle, 

NSFile.Handle «- NSFile.nullHandle, 
DocumentProperties <- NIL, 

MapProperties <- NIL, 

FontProperties «- NIL]; 


General Properties: 

Gene ralPropertyRecord; 
iconName: 
channelSpeed: 
folderName; 
others: 
tagSize: 


TYPE = LONG POINTER TO GeneralPropertyRecord; 
TYPE = RECORD [ 

XString.ReaderBody, 

ChannelSpeed, 

XString.ReaderBody, 

XStri ng . ReaderBody , 

LONG POINTER TO Gene ral TagSi zes £ NIL]; 


DocumentProperties: 
DocumentPropertyRecord: 


TYPE = LONG POINTER TO 
TYPE = RECORD [ 


DocumentPropertyRecord 
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folderName: 
docName: 
justification: 
1ineHeight: 
preLeading: 
postLeading: 
under! i ning : 
guessMark: 
d ropKeepMark: 
pageBreak: 
othe rs: 
tagSize: 


XString.ReaderBody, 

XString.ReaderBody, 

BOOLEAN, 

LineSpacing, 

LineSpacing, 

LineSpacing, 

Unde rl i n i ng , 

XString.ReaderBody, 

DropKeep, 

PageBreak, 

XString.ReaderBody, 

LONG POINTER TO TextTagSizes < NIL]; 


MapProperties: 
MapPropertyRecord: 
header: 
numbe r: 
map: 

tagSize: 


TYPE = LONG POINTER TO MapPropertyRecord; 
TYPE = RECORD [ 

XString.ReaderBody, 

CARDINAL <- 0, 

Mapping <- NIL, 

LONG POINTER TO MapTagSizes <- NIL]; 


ForitProperties: TYPE 
ForitPropertyRecord: 
fonts: 
tagSize; 


LONG POINTER TO FontPropertyRecord; 
TYPE = RECORD [ 

ARRAY [0..9] OF FontRecord, 

LONG POINTER TO FontTagSizes <- NIL]; 


Mapping: 
MappingRecord: 

next: 
from: 
to: 


TYPE = LONG POINTER TO MappingRecord; 
TYPE = RECORD [ 

Mapping f NIL, 

XString. ReaderBody, 

XString.ReaderBody]; 


FontRecord; 

f ont; 
size; 
italics : 
bold: 


TYPE = RECORD [ 
FontSty1e, 
FontSize, 
BOOLEAN, 
BOOLEAN]; 


Channel Speed: 
FontStyle: 

Fon tSize: 

Underl ining: 
LineSpacing: 
DropKeep: 
PageBreak: 
GeneralTagSizes 
TextTagSizes: 
MapTagSizes: 
Fontl'agSi zes: 


TYPE = {ninetySix. fortyEight, three}; -- hectobauds 
TYPE = (modern, classic, titan}; 

TYPE = (eight, ten, twelve, fourteen, 
eighteen, twentyFour}; 

TYPE = (underline, italics, plain}; 

TYPE = (single, singleHalf, double, triple}; 

TYPE = (drop, keep}; 

TYPE = (drop, keep, unfilled}; 

TYPE = ARRAY Generalltems OF CARDINAL <- ALL[0]; 

TYPE = ARRAY Textltems OF CARDINAL <- ALL[0]; 

TYPE = ARRAY Mapltems OF CARDINAL «- ALL[0]; 

TYPE = ARRAY Fontltems OF CARDINAL <- ALL[0]; 


--- Procedures implemented in K4Windowlmpl 

OpenWindow: PROCEDURE [iconData: Containee.DataHandle, 

changeProc: Containee.ChangeProc, 
changeProcData: LONG POINTER, 
tinylcon: XString.Character] 

RETURNS [shell: SWS.Handle «- SWS. null Hand! e] ; 

PutFilelnFolder: PROCEDURE [file: NSFile.Handle, 

folderName: NSString.String]; 


Procedures implemented in K4PSheetImpl 

OpenPSheet: PROCEDURE [iconData: Containee.DataHandle, 

changeProc: Containee.ChangeProc, 
changeProcData: LONG POINTER] 

RETURNS [SWS.Handle]; 

OpenDocOptionSheet: PROCEDURE [ 

convertParm: ConvertParms, 

takeDown: PropertySheet.MenuItemProc]; 
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Procedures implemented in K4Fi1edDatalmpl 


TypeAndVersion: PROCEDURE RETURNS [fileType: NSFile.Type, 

version: Prototype.Version]; 

LoadF'iledData: PROCEDURE [parm: IconParms] 

RETURNS [mismatch: BOOLEAN <- FALSE]; 

StoreFiledData: PROCEDURE [parm: IconParms]; 

FreelconProps; PROCEDURE [props: General Properties, 

z: UNCOUNTED ZONE]; 

FreeTextProps: PROCEDURE [props: DocumentProperties, 

z: UNCOUNTED ZONE]; 

FreeMapProps: PROCEDURE [props: MapProperties, 

z: UNCOUNTED ZONE]; 

FreeFontProps: PROCEDURE [props: FontProperties, 

z: UNCOUNTED ZONE]; 


Procedures implemented in K4DocumentImpl 

ConvertToDocument: PROCEDURE[1ogFi1e: NSFi1e,Handle, 

docProps: DocumentProperties, 
mapProps: MapProperties, 
fonProps: FontProperties]; 


END. -- of K4 

L4-Jan-87 14:35:51 created from DestText and KDEM3. 

28-Jan-87 16:01:53 changed parms of ConvertToViewPoint. 

27-Feb-87 15:56:30 added preliminary ConvertToCanvas. 

3- Mar-87 11:05:03 unified parms for ConvertToViewPoint, ConvertToCanvas, 

4- Mar-87 15:55:03 added PutFilelnFolder. 

9-Mar-87 14:08:49 added CanvasName, IconParmRecord, CanvasParmRecord. 

9-Mar-87 16:43:35 elimination of Courier and addition of options from linked property sheet. Changed 
iconFileType because of filed props changes. 

13- Mar-87 10:12:24 added options and modified others. 

16- Mar-87 9:43:17 version 9; added signature. 

17- Mar-87 13:15:28 added character mapping. 

18- Mar-87 11:04:54 defined OpenDocOptionSheet, OpenCanvasOptionSheet, and dropped all other option 
sheet interfaces. 

18- Mar-87 14:22:38 version 11: preset number to 0, not 1. 

19- Mar-87 10:51:46 moved application file type and version into proc TypeAndVersion to avoid full 
recompilation of all impls at every version change. 

31-Mar-87 12:58:48 removed iconName from StoreFiledData. 

2-Apr-87 11:26:48 added parameter saveLog to ConvertTo... 

6-Apr-87 15:06:18 changed parameters of ConvertToCanvas, ConvertToDocument. 

14- Apr-87 12:56:02 added paragraph line height and leadings, added drop/keep questionable marks. 
24-Apr—87 16:08:12 dropped canvas and ArtScan processing, moved fonts to separate prop sheet. 

27-Apr-87 12:56:49 added folder of transmisions in general items, and choice for page breaks. 

/ 
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-- File: K4Config .config - Last edit: 

-- deLaBeaujardiere:OSBU North:Xerox 3-Aug-88 10:48:04 

-- Copyright (C) 1986 by Xerox Corporation. All rights reserved. 

K4Config: CONFIGURATION 

IMPORTS Atom, Attention, BackgroundProcess, 

Containee, Display, 

DocInterchangeDefs, DocInterchangePropsDefs, 

FormWindow, Heap, 

MenuData, MessageWindow, 

NSFile, NSFileStream, NSString, 

Process, PropertySheet, Prototype, 

RS232C, Runtime, Selection, SimpleTextDisplay, SimpleTextFont, 
StarDesktop, StarWindowShel1, StarWindowShel1Extra2 , 

Stream, XFormat, XString 

CONTROL K4IconImpl = 

BEGIN 

K4Fi1edDatalmpl ; 

K4IconImpl : 

K4PSheetImpl ; 

K4Windowlmpl ; 

K4DocumentImpl ; 

END. 

<< 

4-Mar-87 10:08:27 added K4CanvasImpl and Interpress. 

10-Mar-87 10:16:52 removed K4Fi1edDescription, added K4FiledData. 

23-Mar-87 15:23:27 added MenuData, Selection. 

23- Mar-87 17:00:53 removed CommonConversionlmpl (merged in K4DocumentImpl). 
7-Apr-87 13:45:04 removed starting of K4WindowImpl. 

24- Apr-87 16:55:21 removed K4CanvasImpl, Interpress, String. 

3-Aug-88 10:47:41 added DocInterchangePropsDefs. 

/ 

>> 
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<< File: K4DocumentImpl.mesa 


14-Sep-88 16:02:55 


Parses K4 output and produces structured data 
for input to CommonConversionlmpl 

(which makes a Viewpoint document from the structured data) 
Owner: Advanced Design - User Interfaces - deLaBeaujardiere >> 


DIRECTORY Ascii, BackgroundProcess, 

DocInterchangeDefs, DocInterchangePropsDefs, 

FormWindow, Heap, K4, NSFile, NSFileStream, 

NSString, 

Process, PropertySheet, 

Runtime, StarFileTypes, 

StarWindowShel1, Stream, Window, 

XChar, XCharSetO, XCharSet360, XString; 

K4DocumentImpl: PROGRAM 
IMPORTS BackgroundProcess, 

DocInterchangeDefs, DocInterchangePropsDefs, FormWindow, Heap, K4, 
NSFile, NSFileStream, NSString, 

Process, PropertySheet, Runtime, 

Stream, 

XChar, XCharSetO, XCharSet360, XString 
EXPORTS K4 
SHARES XString = 

BEGIN 

OPEN DI: DocInterchangeDefs, DIP: DocInterchangePropsDefs, 

FW: FormWindow, XS: XString; 


Baseline: TYPE = {null, super, sub}; 

QuestionHandling: TYPE = {keep, dropCharacter, dropstring}; 


Line: TYPE = LONG POINTER TO LineRecord: 
LirieRecord: TYPE = RECORD [ 


next: 
chunk: 
interLine: 
leadingSpaces: 
paragraphHere: 
text: 


Line «- NIL, 

Chunk <- NIL, 

CARDINAL, 

CARDINAL, 

BOOLEAN <- FALSE, 
XS .Wri terBody ] ; 


empty 1ines above 


Chunk: TYPE = LONG POINTER TO ChunkRecord; 
CluinkRecord: TYPE = RECORD [ 

next: Chunk <- NIL, 


aspect: 
firstChar: 
nChars: 


Aspect *- plain, 
CARDINAL <- 0, 
CARDINAL <- 0]; -- 


pointer to beginning position 
number of characters 


Aspect: TYPE = MACHINE DEPENDENT { 
notAnAspect, plain, 
onSubscript, offSubscript, 
onSuperscript, offSuperscript, 
onUnderline, offUnderline, 

onFontO, (9), -- avoid TAB 

onFontl, onFont2, (12), (13), -- avoid FF and CR 

onFont3, onFont4, onFont5, onFont6, 
onFont7, onFont8, onFont9, 
offFontO, offFontl, offFont2, offFont3, 
offFont4, offFont5, (27), -- avoid ESC 

offFont6, offFont7, offFont8, offFont9}; 

-- the above enumeration is to replace in the source 
-- stream the font/underline/subscript/., markers 
-- with characters that cannot be accessed through 
-- the keyboard or are not K4 encodings. 

-- Thus the mapping options typed by 

-- the user cannot interfere with the markers. 


ConversionHandle: TYPE = LONG POINTER TO ConversionData; 

ConversionData: TYPE = RECORD [ 
docHandle: DI.Doc, 

fontProps: DIP.FontPropsRecord, 

paraProps: DIP . ParaPropsRecord, 
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pageProps: DIP.PagePropsRecord, 

tabProps: ARRAY [0..maxTabs) OF DIP.TabStop]; 


WarningLines : TYPE = [0..10); 


tab: 
space: 
lastlnSetO: 
hyphen: 
questionMark: 
substitute: 
paraTab: 
pageEnd: 

1ineEnd: 
propsBegin: 
propsEnd: 
subscript: 
superscript: 
underl i ne: 
fontStyleO: 
fontStylel: 
fontSty1e2: 
fontSty1e3: 
fontSty1e4: 
fontSty1e5 : 
fontSty1e6 : 
fontSty1e7: 
fontSty1e8 : 
fontStyie9 : 
escape: 


XChar.Character 
XChar.Character 
XChar.Character 
XChar.Character 
XChar.Character 
XChar.Character 
XChar.Character 
XChar.Character 
XChar,Character 
XChar.Character 
XChar.Character 
XChar.Character 
XChar.Character 
XChar.Character 
XChar.Character 
XChar.Characte r 
XChar.Character 
XChar.Character 
XChar.Character 
XChar.Character 
XChar.Character 
XChar.Character 
XChar.Character 
XChar.Characte r 
XChar.Character 


XCharSetO.Make [tab]; 

XCharSetO.Make [space]; 

XCharSetO.Make [lowerEng]; 

XCharSetO.Make [minus]; 

XCharSetO.Make [questionMark]; 
XCharSet360.Make [blackRectGraphic]; 
XCharSetO.Make[LOQPHOLE[211C]]; 
XCharSetO.Make[LOOPHOLE[014C]]; 
XCharSetO.Make[LOOPHOLE[015C]] ; 
XCharSetO.Make[LOOPHOLE['<.ORD]]; 
XCharSetO.Make[LOOPHOLE[’>.ORD]]; 
XCharSetO.Make[LOOPHOLE[’i.ORD]]; 
XCharSetO.Make[LOOPHOLE[ 1 s.ORD]]; 
XCharSetO.Make[LOOPHOLE['u.ORD]]; 
XCharSetO.Make[LOOPHOLE['0.ORD]]; 
XCharSetO.Make[LOOPHOLE[' 1 .ORD]]; 
XCharSetO.Make[LOOPHOLE['2.ORD]]; 
XCharSetO.Make[LOOPHOLE[’3.ORD]]; 
XCharSetO.Make[LOOPHOLE[ 1 4.ORD]]; 
XCharSetO.Make[LOOPHOLE['5.ORD]]; 
XCharSetO.Make[LQOPHOLE['6.ORD]]; 
XCharSetO,Make[LOOPHOLE['7.ORD]]; 
XCharSetO.Make[LOOPHOLE['8.ORD]]; 

XCharSetO.Make[LOOPHOLE['9 .ORD]]; 
XCharSetO.Make[LOOPHOLE[033C]]; 


onelnch: 
spaceWidth: 
maxTabs; 

fourthlnch : 
fiveInches ; 

I iriesFor8Inches 
poi n tsPe rLine: 


CARDINAL = 1440; 

CARDINAL = onelnch / 10; 

CARDINAL =8; --8 arbitrary tabs 

-- half an inch apart 
CARDINAL = onelnch / 4; 

CARDINAL = onelnch • 5; 

CARDINAL = 48; -- 6 lines per inch X 8 

CARDINAL = 12; 


ConvertToDocument: 


PUBLIC PROCEDURE [ 

logFile: NSFi1e.Handle, 
docProps: K4.DocumentProperties, 
mapProps: K4.MapProperties, 
fonProps: K4.FontProperties] = 


BEGIN 

--- This procedure copies the parameters in a record 

of its own, so that the original can be freed by the client. 
It then paints either an option sheet 

or a warning sheet requesting that Interpress be loaded. 
Control returns to client as soon as the sheet is painted. 

--- Zone and nodes acquired here are freed by ReleaseParm. 

ownZone; UNCOUNTED ZONE «- Heap ,Create[ 1] ; 

cp : K4.ConvertParms «- ownZone . NEW[K4 . ConvertParmsRecord] ; 

source, sink, map: K4.Mapping <- NIL; 

op. zone «- ownZone; 
cp . logFi 1 e *- logFile; 

cp.docProps <- ownZone.NEW[K4.DocumentPropertyRecord]; 
cp.docProps? <- docProps?; 

cp.docProps.folderName < XS.CopyToNewReaderBody[ 

OdocProps.folderName, cp.zone]; 
cp . docProps . docName «- XS .CopyToNewReaderBody[ 

OdocProps.docName, cp.zone]; 
cp ,docProps .guessMark <- XS.CopyToNewReaderBody[ 

SdocProps.guessMark, cp.zone]; 
cp . docProps . others <- XS.CopyToNewReaderBody[ 

SdocProps.others, cp.zone]; 
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cp.mapProps <- ownZone.NEW[K4.MapPropertyRecord]; 

cp.mapProps.header <- XS.CopyToNewReaderBody[@mapProps . header, cp.zone]; 
cp .mapProps . number «- mapProps . number; 
source < mapProps.map; 

F : OR k: CARDINAL IN [ 1.. mapProps . number] DO 
map <- cp.zone.NEW [K4.MappingRecord <- [ 

from; XS.CopyToNewReaderBody[@source.from, cp.zone], 
to: XS.CopyToNewReaderBody[@source.to, cp.zone], 

next: NIL]]; 

IF cp.mapProps.map = NIL 

THEN cp . mapP rops .map <- map 
ELSE sink.next «- map; 
sink «- map; 
source <- source.next; 

ENDLOOP; 

cp.fonProps «- ownZone,NEW[K4.FontPropertyRecord]; 
cp.fonPropst <- fonPropsT; 

IF Runtime.IsBound [LOOPHOLE [DI.StartCreation]] 

THEN K4.0penDoc0ptionSheet [cp, TakeDownSheet] 

ELSE ShowWarning [cp]; 

END; -- of ConvertToDocument 


TakeDownSheet: PropertySheet.MenuItemProc = 

BEGIN 

cp : K4 .ConvertParms <- L00PH0LE[cl ientData] ; 

IF menultem = start 

THEN Process.Detach [FORK ConvertProcess[cp]] 
ELSE ReleaseParrr [cp]; 
ok <- TRUE; 

END; -- of TakeDownSheet 


ShowWarning: PROC [cp: K4.ConvertParms] = 

BEGIN 

pSheetName: XS.ReaderBody «- XS. FromSTRING ["Kurzweil Converter"L]; 
pS'ize: Window.Dims «- [420, 300]; 
pPIace: Window.Place <- [550, 100]; 

[] «- PropertySheet.Create [formWindowItems: MakeWarning, 

formWindowlternsLayout: Layoutwarning, 

menuItemProc: Exitwarning, 

menultems: [done: TRUE, cancel: TRUE], 

title: QpSheetName, 

size: pSize, 

placeToDisplay: pPIace, 

clientData: cp]; 

END; -- of ShowWarning 


MakeWarning: FW.MakeltemsProc = 

BEGIN 

txt: ARRAY WarningLines OF LONG STRING «- [ 

"VP Editor is needed to make a document, but is not running."L, 
"Please run the following applications (if they are idle,"L, 
"then press <Done>:"L, 

" Font Manager"L, 

" Workstation Keyboards"L, 

" Keyboards"L, 

" Interscript Converter"L, 

" VP Document Editor"L, 

II M 

"If want to drop the document creation, press <Cancel>."L]; 
msg: XString.ReaderBody; 

FOR k: WarningLines IN WarningLines DO 
msg «- XStri ng . FromSTRING[txt[k]] ; 

FW.MakeTextltem [window: window, myKey: k, 

tag: NIL, readonly: TRUE, boxed: FALSE, 
width: 400, initString: @msg]; 

ENDLOOP; 

END; -- of MakeWarning 
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LavoutWarninq: FW.LayoutProc = 

BEGIN 

FOR k: WarningLines IN WarningLines DO 

line: FW.Line <- FW. AppendLine [window: window, spaceAboveLine: 0]; 
FW.Appendltem [window: window, item: k, 

line: line, preMargin: 10]; 

ENDLOOP; 

END; -- of Layoutwarning 


ExitWarning: PropertySheet.MenultemProc = 

BEGIN 

op: K4 .ConvertParms <- LOOPHOLE[clientData]; 
newMsg : XString .ReaderBody «- XString . FromSTRING[ 

"The Document Editor is still not running,.."L]; 

IF menultem = cancel THEN 
BEGIN 

ReleaseParm [cp]; 

RETURN [TRUE]; 

END; 

IF Runtime.IsBound[LOOPHOLE[DI.StartCreation]] THEN 
BEGIN 

l<4 .OpenDocOptionSheet [cp, TakeDownSheet] ; 

RETURN [TRUE]; 

END; 

FW.SetTextltemValue [formWindow, 0, SnewMsg, TRUE]; 
RETURN [FALSE]; 

END; -- of ExitWarning 


ConvertProcess: PROCEDURE [cp: K4.ConvertParms] = 

BEGIN 

processName: XS. ReaderBody <- XS.FromSTRING["Making Document"L]: 

ManagedProcess: BackgroundProcess.CallBackProc = 

-- ManagedProcess must be within ConvertProcess 
-- to be supervised by the Background Processor 

BEGIN 

ENABLE UNWIND => (finalStatus <- aborted; CONTINUE); 


zone: UNCOUNTED ZONE 
rawText: XS.WriterBody; 
firstLine, currentLine: Line <- NIL; 


cp. zone; 


line: 
map: 

maxMapLength: 
leadingSpaces: 
emptyLinesAbove: 
coriversionHandle: 
docFi1e: 
docSession: 
status: 


Line; 

K4.Mapping «- NIL; 
CARDINAL «- 0; 

CARDINAL; 

CARDINAL <- 0; 
ConversionHandle; 

NSFi1e.Hand!e; 

NSFi1e.Session; 

DI.FinishCreationStatus; 


docNSName, folderNSName: NSString.String; 


docAttributes: 
logStream: 


ARRAY [0..1) OF NSFi1e.Attribute; 
Stream.Handle; 


hasProps, endOfPage, endOfStream: BOOLEAN «- FALSE; 


qHandling : 
qCharacter: 
qStri ng : 


QuestionHandling; 
XS.Character; 

XS.Reader; 


accelerator 

accelerator 


ConversionHandle «- Beg i nDocument [zone, cp.docProps, cp . f onProps] ; 
IF ConversionHandle = NIL THEN RETURN; -- creation failed 


IF (cp.mapProps # NIL) 

AND (cp.mapProps.map # NIL) 

AND (NOT XS.Empty [@cp.mapProps.map.from]) THEN 

[map, maxMapLength] <- OrderMap [cp.mapProps.map]; 

qString <- @cp.docProps.guessMark; 

SELECT TRUE FROM 

cp.docProps.dropKeepMark = keep => qHandling < keep; 
XS.CharacterLength[qString] = 1 => 

BEGIN 
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qHandl ing <- dropCharacter; 
qCharacter «- XS. Lop[qStri ng] ; 

END; 

ENDCASE => qHandling «- dropstring; 

logStream «- NSFi 1 eStream.Create [cp.logFile, FALSE]; 

Stream.SetlnputOptions [iogStream, [signaiEndOfStream: TRUE]]; 

rawText <- XS.NewWriterBody [300, zone]; 

-- large enough to contain a whole line 
-- in small font. Will be expanded if needed. 


DO 

-- get a raw line of text 

[leadingSpaces, hasProps, endOfPage, endOfStream] «- FillBuffer [ 

IogStream, SrawText, 
qHandling, qCharacter, qString]; 

IF XS.Empty [XS.ReaderFromWriter[@rawText]] THEN 
emptyLinesAbove «* emptyLinesAbove + 1 
ELSE 
BEGIN 

line «- zone.NEW [LineRecord] ; 

IF firstLine = NIL THEN currentLine <- firstLine « line 
ELSE currentLine currentLine. next <- line; 

1 i ne . 1 eadingSpaces <- leadingSpaces; 

1 ine. interLine <- emptyLi nesAbove ; 

emptyLinesAbove «- 0; 

line, text <- XS.CopyToNewWriterBody[ 

XS.ReaderFromWriter[@rawText], zone]; 

IF map # NIL THEN Map [XS.ReaderFromWriter[@rawText], ©line.text, map]; 

IF hasProps THEN Parcel [line, zone]; 

END; 

IF endOfPage THEN -- end of page found after current line 
BEGIN 

linesInPage: CARDINAL FillDocument [conversionHandle, firstLine, 

cp . fonProps, 

cp .docProps.underlining]; 

SELECT cp.docProps,pageBreak FROM 
drop => NULL; 

keep => DI.AppendPageBreak [conversionHandle.docHandle, 

SconversionHandle.fontProps]; 
unfilled => IF linesInPage < 1inesFor8Inches THEN 

DI.AppendPageBreak [conversionHandle.docHandle, 

SconversionHandle.fontProps]; 

ENDCASE; 

ReleaseLines [firstLine, zone]; 
firstLine <- NIL; 
emptyLinesAbove <- 0; 

END; 

IF endOfStream THEN EXIT; -- end of stream found after current line 

ENDLOOP; -- loop to get next raw line 

[] <- FillDocument [conversionHandle, firstLine, 

cp.fonProps, cp.docProps.underlining]; 

ReleaseLines [firstLine, zone]; 

[docFile, docSession, status] <- DI. Fi n ishCreati on[@convers ionHandl e. docHandle] ; 

IF docFile # NSFi1e.nul1 Hand!e THEN 

BEGIN -- reopen docFile in null session 

ENABLE NSFile.Error => 

{ 

NSFi1e.Close[docFi1e, docSession ! NSFile.Error => CONTINUE]; 
docFile <- NSFi 1 e . null Hand! e ; 

CONTINUE; 

}; 

tmpRef: NSFile.Reference «- NSFi 1 e .GetRef erence[f i 1 e : docFile, 

session: docSession]; 

tmpFile; NSFile.Handle <- docFile; 

docFile NSFi 1 e .OpenByRef erence[ ref erence : tmpRef]; 

NSFile.Close[tmpFile, docSession]; 

NSFile.LogofffdocSession ! NSFile.Error => CONTINUE]; 
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END; 


docNSName «- XS.NSStringFromReader [ 

@cp.docProps.docName, zone]; 
docAttributes[0] <- [name[docNSName]]; 

NSFile.ChangeAttributes [docFile, DESCRIPTOR [docAttributes]]; 
NSString.FreeString [zone, docNSName]; 

To I derNSName <- XS.NSStringFromReader [ 

@cp.docProps.folderName, zone]; 

K4.PutFi1elnFolder [docFile, folderNSName]; 

NSString.FreeString [zone, folderNSName]; 

MSFile.Close [docFile]; 

Stream.Delete [logStream]; 

XS.FreeWriterBytes [OrawText]; 

ReleaseParm [cp]; -- done last, beause it releases the zone 

END; -- of ManagedProcess 

Process.SetPriority[Process.priorityBackground]; 

[] «- BackgroundProcess .ManageMe[name : OprocessName, 

cal 1BackProc: ManagedProcess, 
abortable: FALSE]; --** TRUE later 

END; -- of ConvertProcess 


FillBuffer: PROC [stream: 

bufferW: 
qHandling: 
qCharacter: 
qString: 

RETURNS [1eadingSpaces: 
hasProps: 
endOfPage; 
endOfStream; 

BEGIN 


Stream.Handle, 

XS. Wri te r , 
QuestionHandling, 
XS.Character, 

XS.Reader] 

CARDINAL «- 0, 
BOOLEAN <- FALSE, 
BOOLEAN <- FALSE, 
BOOLEAN <- FALSE] = 


-- Gets a line of text in buffer, up to next CR or FF. 

-- Drops the leading spaces. 

-- Replace strings of 3 or more spaces by a tab. 

-- Replaces props marker by ESC+code so that they cannot 
-- changed by user mapping options. 

ENABLE Stream.EndOfStream => GOTO EndStream; 
xChar, yChar: XChar.Character; 
aspect: Aspect; 
insideSpaces, k: CARDINAL; 


be 


NextChar: PROC RETURNS [XS.Character] = INLINE 

{RETURN [XCharSetO,Make[LOOPHOLE[St ream.GetByte [stream]]]]}; 

XS.ClearWriter [bufferW]; 
insideSpaces <- 0; 


DO -- count and drop leading spaces 

xChar *-■ NextChar[]; 

IF xChar # space THEN EXIT; 
leadinqSpaces r leadingSpaces + 1; 

ENDLOOP; 


DO -- get remainder of line 

SELECT TRUE FROM 

xChar = lineEnd => RETURN; 

xChar = pageEnd => {endOfPage <- TRUE: RETURN}; 

qHandling = dropCharacter 

AND xChar - qCharacter => NULL; 

xChar = propsBegin => -- replace begin-props markers 

BEGIN 

yChar <- NextChar[]; 
aspect «- SELECT yChar FROM 
underline => onUnderline, 
subscript => onSubscript, 
superscript => onSuperscript, 
fontStyleO => onFontO, 
fontStylel => onFontl, 
fontStyle2 => onFont2, 
fontStyle3 => onFont3, 
fontStyle4 => onFont4, 
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fontStyle5 => onFont5, 
fontStyle6 => onFont6, 
fontStyle7 => onFont7, 
fontStyle8 => onFont8, 
fontStyle9 => onFont9, 

ENDCASE => notAnAspect; 

IF aspect = notAnAspect THEN 

{XS.AppendChar [bufferW, xChar]; 

XS.AppendChar [bufferW, yChar]} 

ELSE 

(XS.AppendChar [bufferW, escape]; 

XS.AppendChar [bufferW, 

XCharSetO,Make[LOOPHOLE[aspect]]]; 
hasProps <- TRUE); 

END; 

xChar = propsEnd => -- replace end-props markers 

BEGIN 

yChar <- NextChar[]; 
aspect *• SELECT yChar FROM 
underline => offUnderline, 
subscript => offSubscript, 
superscript => offSuperscript, 
fontStyleO => offFontO, 
fontStylel => offFontl, 
fontStyle2 => offFont2, 
fontStyle3 => offFont3, 
fontStyle4 => offFont4, 
fontStyle5 => offFont5, 
fontStyle6 => offFont6, 
fontStyle7 = > offFont7, 
fontStyle8 => offFont8, 
fontStyle9 => offFont9, 

ENDCASE => notAnAspect; 

IF aspect = notAnAspect THEN 
(XS.AppendChar [bufferW, xChar]; 

XS.AppendChar [bufferW, yChar]} 

ELSE 

(XS.AppendChar [bufferW, escape]; 

XS.AppendChar [bufferW, 

XCharSetO.Make[LOOPHOLE[aspect]]]; 
hasProps *■ TRUE}; 

END; 

xChar = space => insideSpaces <- insideSpaces + 1 ; 

-- count embedded spaces 

xChar IN (space..lastlnSetO] => 

BEGIN 

-- replace space strings by tab or space 
SELECT insideSpaces FROM 
0 => NULL; 

>5 = > XS.AppendChar [bufferW, tab]; 

ENDCASE => 

BEGIN 

FOR k IN [1..insideSpaces] DO 
XS.AppendChar [bufferW, space]; 

ENDLOOP; 

END; 

XS.AppendChar [bufferW, xChar]; 
insideSpaces *- 0; 

END; 

xChar = tab => 

XS.AppendChar [bufferW, xChar]; 

ENDCASE => 

XS.AppendChar [bufferW, substitute]; 

-- ** handle questionable char "dropstring" later 

xChar <- NextChar []; 

ENDLOOP; 

EXITS EndStream => (endOfStream <- TRUE}; 

END; -- of FillBuffer 


Parcel: PROC [line: Line, zone: UNCOUNTED ZONE] = 

BEGIN 

-- Font or aspect markers found in line.text generate 
-- a linked list of "chunks”. 
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-- There is at least one marker when we enter this proc. 

code: XChar.Character; 

index: CARDINAL «- 0; 

source: XS.Reader <- XS. ReaderFromWri te r[@l ine . text] ; 

newChunk: Chunk <- NIL; 

currentChunk : Chunk *- zone.NEW [ChunkRecord] ; 
line.chunk «- currentChunk; 

WHILE index < XS.ByteLength[source] DO -- parse source text 

code *■ XS.NthCharacter [source, index]; 

IF code # escape THEN 
BEGIN 

index «- index + 1; 

END 

ELSE 

BEGIN 

currentChunk. nChars «- index - currentChunk .f i rstChar; 

-- Make a new chunk, unless the current chunk is at beginning of line. 
IF index > 0 THEN 
BEGIN 

newChunk <- zone.NEW [ChunkRecord]; 
currentChunk , next «- newChunk; 
currentChunk newChunk; 

END; 

code «- XS.NthCharacter [source, index + 1]; 
currentChunk. aspect *- LOOPHOLE[XChar. Code[code] , Aspect]; 
index *- index + 2; 
currentChunk. fi rstChar <■- index; 

END; 

ENDLOOP: 

currentChunk . nChars «- index - cu rrentChunk . fi rstChar; 

END; -- of Parcel 


ReleaseLines: PROC [firstLine: Line, z: UNCOUNTED ZONE] = 
BEGIN 

line: Line <- f i rstLine; 

holdLine: Line «- NIL; 

chunk, holdChunk: Chunk <- NIL; 

DO 

IF line = NIL THEN RETURN; 
chunk <- line, chunk; 

DO 

IF chunk = NIL THEN EXIT; 
holdChunk <- chunk.next; 
z.FREE [@chunk]; 
chunk <- holdChunk; 

ENDLOOP; 

XS.FreeWriterBytes [@1ine.text]; 
holdLine *- line.next; 
z.FREE [@1ine]; 

1ine ft holdLine; 

ENDLOOP; 

END; -- of ReleaseLines 


ReleaseParm: PROC [cp: K4.ConvertParms] = 
BEGIN 

z: UNCOUNTED ZONE f* cp.zone; 

NSFile.Close [cp.log File]; 

K4.FreeTextProps [cp.docProps, z]; 

K4.FreeMapProps [cp.mapProps, z]; 

K4.FreeFontProps [cp.fonProps, z]; 
z.FREE [@cp] ; 

Heap.Delete [z]; 

END; -- of ReleaseParm 


BeginDocument: PROCEDURE [z: UNCOUNTED ZONE, 

docProps: K4.DocumentProperties, 
fonProps: K4.FontProperties] 
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RETURNS [document: LONG POINTER] = 

BEGIN 

h: ConversionHandle <- z.NEW [ConversionData]; 

DIP.GetPagePropsDefauIts[@h.pageP rops]; 

DIP.GetFontPropsDefaults[@h.fontProps]; 

h . font Props . fontDesc. poi ntSize «- 

SELECT fonProps.fonts[0].size FROM 

twelve => 12, 
ten => 10, 
eight => 8, 

fourteen => 14, 

ENDCASE => 12; 

h . fontProps . fontDesc .weight <- IF f onProps . fonts[0] .bold 
THEN bold ELSE medium; 

h . fontProps . fontDesc,designVariant *■ IF fonProps . fonts[0] . ital ics 
THEN italic ELSE roman; 

h . fontProps . fontDesc, fami ly *■ 

SELECT fonProps.fonts[0].font FROM 

classic => century, 
modern => frutiger, 

ENDCASE => titan; 

DIP.GetParaPropsDefaults[@h.paraProps]; 

h . paraProps . basicProps .p reLeadi ng *- SELECT docProps . preLeadi ng FROM 

single => 0, 
singleHalf => 6, 
double => 12, 

ENDCASE => 24; 

h . paraProps . basi cProps .postLeadi ng «- SELECT docProps .postLeading FROM 

single => 0, 
singleHalf => 6, 
double => 12, 

ENDCASE => 24; 

h . paraP rops . basi cProps . 1 i neHeight <- SELECT docProps . 1 ineHeight FROM 

single = > 12, 
singleHalf => 18, 
double => 24, 

ENDCASE => 36; 

h , paraP rops . basi cProps . j usti f i ed «- docProps .justif ication ; 

h . paraProps . tabStops «- DESCRIPTOR [h . tabProps] ; 

FOR k: CARDINAL IN [0..maxTabs) DO -- set 12 tabs at 1/2 inch 

h , tabProps[k] . dotLeader «- FALSE; 

h . tabProps[k] . tabStopOf f set «- 36 * k; -- 72 points/inch 

h . tabPropsTk] . tabStopAl ignment left; 

ENDLOOP; 

[ h , docHandle,,,, , ] *- DI .StartCreation [ 

simple, -- simple pagination 
FALSE, -- no header 
FALSE, -- no footer 
@h . fontProps, 

@h. paraProps, 

@h.pageProps]; 

document <- h ; 

END; -- of BeginDocument 


Fi11 Document: PROC [h; ConversionHand1e, 
lineList: Line, 

fontOptions: K4.FontProperties, 
underOption: K4.Underlining] 

RETURNS [1inesInPage: CARDINAL «- 0] = 

BEGIN 

partialBody: XS,ReaderBody; 

fullReader: XS.Reader; 

context; XS,Context <- XS.vani 11 aContext; 

line: Line; 

lastChar: XChar.Character; 

IF lineList = NIL THEN RETURN; 

MarkParagraphs [lineList, FALSE]; 

-- Find the paragraph boundaries 
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f : OR line *- lineList, line.next WHILE line # NIL DO 


linesInPage «- linesInPage + 1 + 1 ine . i nterLi ne; 

-- count to see where is the last line in the page; 

-- if it lies "far up enough" from the bottom 
-- (arbitrarily, 3" from bottom, 8" from top), 

-- we will issue a page break. 

IF 1ine.paraqraphHere THEN 
BEGIN 

h . fontProps. nUnderl ines <- 0; -- turn off underline at 

-- beginning of a paragraph 

FOR k; CARDINAL IN [2..1ine.interLine) DO -- make white space 
DI.AppendNewParagraph [[doc[h.docHandle]], 

@h . paraProps, 

@h .fontProps]; 

ENDLOOP; 

DI.AppendNewParagraph [[doc[h.docHandle]], 

@h.paraProps, Oh.fontProps]; 

END; 

fullReader <- XS.ReaderFromWriter[@line.text]; 

IF line.chunk = NIL THEN 
BEGIN 

DI.AppendText [[doc[h.docHandle]], fullReader, 

XS.vani11aContext, @h.fontProps]; 

END 

ELSE 

BEGIN 

FOR chunk: Chunk <- line.chunk, chunk.next WHILE chunk tt NIL DO 
SetAspect [chunk, fontOptions, underOption, @h.fontProps]; 

IF chunk.nChars > 0 THEN 
BEGIN 

[partialBody, context] <- XS.Piece [fullReader, 

chunk.firstChar, 
chunk.nChars]; 

DI.AppendText [[doc[h.docHandle]], 

OpartialBody, context, @h.fontProps]; 

END; 

ENDLOOP; -- loop to process next chunk in line 
END; 

-- Put a space after the last character of the line 
-- unless there is already a space or an hyphen. 
lastChar «- XS, NthCharacter [fullReader, 

XS.CharacterLength[fullReader] - 1]; 
IF lastChar # space AND lastChar # hyphen THEN 

DI.AppendChar [[doc[h.docHandle]], space, @h.fontProps]: 
ENDLOOP; -- loop to process next line 

END; — of Fill Document 


SetAspect; PROC [chunk: Chunk, 

fontOptions: K4.FontProperties, 
underOption: K4.Underlining, 
vpFont: DIP.FontProps] = 

BEGIN 

-- Given a chunk of text with an aspect code, 

-- and given the font choices made by the user, 

-- adjust a property of the VP font as required. 

SetFont: PROC [fontChoice: K4.FontRecord] = 

BEGIN 

vpFont. fontDesc. f ami 1 y «- SELECT f ontChoi ce . f ont FROM 

classic => century, 
modern => frutiger, 
titan => titan, 

ENDCASE => century; 

vpFont. fontDesc .weight *- IF fontChoice.bold 

THEN bold ELSE medium; 

vpFont.fontDesc.designVariant «- IF fontChoice . ital ics 

THEN italic ELSE roman; 

vpFont. fontDesc . pointSi ze <- SELECT fontChoice . size FROM 

twelve => 12, 
ten => 10, 
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eight => 8, 

fourteen => 14, 

ENDCASE => 12; 

IF fontChoice.font = titan THEN 
BEGIN 

vpFont. f ontDesc. designVari ant «- roman; -- in case it was italics 
IF vpFont.fontDesc.pointSize < 10 THEN 

vpFont.fontDesc.pointSize *■ 10; 

IF vpFont.fontDesc.pointSize > 12 THEN 

vpFont. fontDesc , pointSize «- 12; 

END; 

END; -- of SetFont 

SELECT chunk,aspect FROM 

onSubscript => vpFont.piacement *- sub; 
offSubscript => vpFont.piacement t null; 
onSuperscript => vpFont. pi acement «- super; 
offSuperscript => vpFont. pi acement <- null; 
onUnderline => SELECT underOption FROM 

underline => vpFont. nUnderl ines *■ 1; 
italics => {vpFont. nUnderl i nes «- 0; 

vpFont. f ontDesc. designVari ant «- italic}; 
plain => vpFont. nUnderl ines <- 0; 

ENDCASE; 

offUnderline => SELECT underOption FROM 

underline => vpFont. nUnderl ines <- 0; 
italics = > (vpFont. nUnderl ines «- 0; 

vpFont.fontDesc.designVariant <- roman}; 
plain => vpFont. nUnderl ines «- 0; 

ENDCASE; 

onFontO => SetFont [fontOptions.fonts[0]] ; 

onFontl => SetFont [fontOptions.fonts}1]]; 

onFont2 => SetFont [fontOptions.fonts[2]]; 

onFontS => SetFont [fontOptions.fonts[3]]; 

onFont4 => SetFont [fontOptions.fonts[4]]; 

onFontS => SetFont [fontOptions.fonts[5]]; 

onFont6 => SetFont [fontOptions.fonts[6]]; 

onFont7 => SetFont [fontOptions.fonts[7]]; 

onFont8 => SetFont [fontOptions.fonts[8]]; 

onFont9 => SetFont [fontOptions.fonts[9]]; 

ENDCASE => SetFont [fontOptions.fonts[0]]; -- restore font 0 

END; -- of SetAspect 


Map: PROC [fromR: XS.Reader, toW; XS.Writer, mapOptions: K4.Mapping] = 
BEGIN 

fromlndex: CARDINAL «- 0; 

fromMapLg: CARDINAL; 

piece: XS.ReaderBody; 

context: XS.Context; -- not used... 

XS.ClearWriter [toW]; 

WHILE fromlndex < XS.CharacterLength [fromR] DO 

FOR map: K4.Mapping <- mapOptions, map.next WHILE map # NIL DO 
fromMapLg «- XS.CharacterLength [@map.from]; 

[piece, context] «- XS.Piece [fromR, fromlndex, fromMapLg]; 

IF XS.Equal [@piece, Smap.from] THEN 
BEGIN 

XS.AppendReader [toW, Omap.to]; 
fromlndex «• fromlndex + fromMapLg; 

EXIT; 

END; 

REPEAT 

FINISHED => BEGIN -- no mapping match 

XS.AppendChar [toW, XS.NthCharacter [fromR, fromlndex]]; 
fromlndex «- fromlndex + 1; 

END; 

ENDLOOP; 

ENDLOOP; 

END; -- of Map 
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OrderMap: PROC [map: K4.Mapping] RETURNS [K4.Mapping, CARDINAL] = 
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BEGIN 

-- This procedure sorts the mapping entries by string length, 
placing the longest string first. 

-- The sort technique is a bit crude, because we don't have 
-- back pointers, but the lists are generally short. 

prior, current, next, hold: K4.Mapping <- NIL; 
entryHasMoved: BOOLEAN <- FALSE; 

IF map = NIL THEN RETURN [NIL, 0]; 

<<** not working correctly yet 
entryHasMoved <- TRUE; 

WHILE entryHasMoved DO 
entryHasMoved «- FALSE; 
prior <- current <- map; 
next «- map.next; 

DO 

IF next = NIL OR current = NIL THEN EXIT; 

IF XS.ByteLength [Onext.from] > 

XS.ByteLength [Scurrent.from] THEN 
BEGIN 

IF current = prior THEN 
BEGIN 

map «- next; 

map.next «- current; 

current.next <- next.next; 

END 

ELSE 

BEGIN 

hold <- prior . next; 
prior, next <- current, next; 
current,next <- next.next; 
next.next <- hold; 

END; 

entryHasMoved «- TRUE; 

EXIT- 

END; 

prior «- prior, next; 
current t current.next; 
next <- next.next; 

ENDLOOP; 

ENDLOOP; 

**>> 

RETURN [map, 10]; --**10 is temp... 

END; -- of OrderMap 


MarkParagraphs: PROC [firstLine: Line, 

keepLineBreak: BOOLEAN] = --** unused for now 

BEGIN 

-- We think there is a paragraph if one of the following is true: 
-- 1) the line has an interval (i.e distance from line above) 
greater than the smallest line interval; 

-- 2) the line above is "clearly" shorter than the current line, 
("clearly" arbitrarily defined as 1 inch), 

-- 3) the line is "clearly" indented from the prior line's, 
("clearly" arbitrarily defined as 1/4 inch). 

line: Line; 

priorMargin, smallestMargin : CARDINAL «- LAST[CARDINAL] ; 

priorLength, lineLength: CARDINAL; 

smal 1 estlnterl ine: CARDINAL «- LAST[CARDINAL] ; 

LineLength: PROC [r: XS.Reader] RETURNS [length: CARDINAL] = 

BEGIN 

length «- XS.CharacterLength [r] * onelnch / 10; 

-- Grossly approximative. Need better way... 

END; -- of LineLength 

If we must keep line breaks, no point looking further... 

IF keepLineBreak THEN 
BEGIN 

FOR line < firstLine, line.next WHILE line # NIL DO 
1 ine.paragraphHere <- TRUE; 

ENDLOOP; 

RETURN; 
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END; 


-- Find the smallest line interval, to tell us if 

-- the text is generally single-spaced, or double-spaced, etc.. 

-- and find the smallest left margin. 

FOR line <- firstLine, line.next WHILE line # NIL DO 

smal 1 estlnterl ine *- MIN [smallestlnterl ine, 1 ine . interLi ne] ; 
smal lestMargin *■ MIN [smallestMargin, 1 i ne . 1 eadingSpaces] ; 
ENDLOOP; 

priorLength <- LineLength [XS.ReaderFromWriter[@f i rstLine . text]] ; 

FOR line «- firstLine,next, line.next WHILE line # NIL DO 
lineLength <- LineLength [XS. Reade rF romWriter[@l ine. text]] ; 

1 ine.paragraphHere <- 

(1ine.interLine > smallestlnterline) 

OR (priorLength + onelnch < lineLength) 

OR (line.!eadingSpaces > priorMargin + fourthlnch) 
OR (1ine.paragraphHere); -- already a paragraph 

priorLength «- lineLength; 
priorMargin <- 1 ine. 1 eadi ngSpaces ; 

ENDLOOP; 

END; -- of MarkParagraphs 


END. -- of K4DocumentImpl 

5-Feb-87 12:48:28 upgraded to new version of CommonConversion, and to new parameter for 
ConvertToDocument. 

10-Feb-87 14:05:39 added auto creation of folder, movement of document into folder. 

18-Feb-87 17:51:47 added NIL header/footer parameters for BeginDocument. 

4-Mar-87 9:48:28 adapted to new common parameters for ConvertToDocument and ConvertToCanvas. 

4- Mar-87 13:55:18 added presetting of fontChoices to user options. 

10- Mar-87 15:06:03 adapted to linked pSheet. 

11- Mar-87 17:41:42 moved here from K4WindowImpl the test for Editor loaded. 

14-Mar-87 10:25:11 forgot to call SetTextOptions. 

18- Mar-87 11:02:41 replaced all option sheet logic by call to OpenDocOptionSheet. 

19- Mar-87 10:20:41 released mapProps in ReleaseParm. 

23-Mar-87 16:01:01 forgot to test for ''cancel" in option sheet. 

23- Mar-87 16:14:13 merged in ComonConversionlmpl to handle string substitutions. 

26- Mar-87 11:29:57 increased width of warning text. Redesigned entire 1ine/subLines concept, replaced 
with line/pieces, dropped String interface and used XString for buffer. 

2- Apr-87 12:43:03 named logFile according to document name. 

3- Apr-87 11:06:45 implemented mapping. 

5- Apr-87 11:23:54 was quitting on blank lines. 

5- Apr-87 11:48:11 characters outside [space..376B] not caught. 

6- Apr-87 10:33:28 upgraded paragraph recognition procedure, removed leading spaces. 

6- Apr-87 15:26:20 creation of Convertparms moved here from K4WindowImpl. 

7- Apr-87 14:30:31 moved out saving of logFile; had problem with holding same handle in two processes. 

7- Apr-87 17:25:45 reduced interline in warning window. 

13- Apr-87 14:41:18 checked for empty fist map.from; release bytes of bufferWB. 

14- Apr-87 11:27:58 released resources when cancelling document creation. 

14~Apr-87 13:13:16 added pre/post/lineHeight. 

20- Apr-87 13:53:25 picked up initial font size/style/slant/weight from docProps. 

24- Apr-87 16:47:32 new parameter fonProps, fonts moved out of docProps. 

27- Apr-87 13:44:28 page break choices. 

28- Apr-87 18:22:02 underlining vs italics vs plain choice. . 

8- May-87 13:22:14 looks like automatic expansion of bufferW did not work; added code to expand it 

manually. ,. . 

8-May-87 13:23:18 when font aspect change occurs after first character, all chars between first ana 
the aspect change are dropped; extensive change, including new design of the way to translate the 
input text according to the mapping options. 

14-May-87 9:31:20 insured that titan font is not italics and in [10, 12]. 

23~Mar-88 15:18:13 mapped tab into tab (was changed to substitute before); fixed the algorithm 
assigning a paragraph mark on certain lines (it was making a paragraph of the last line of real 
paragraphs!); made paragraphs of lines less than 5 inches long. 

5-Apr-88 14:36:41 when a string of spaces are found inside a line, replace it with a tab if there are 
more than 5 spaces (rather than 3 spaces); removed the criteria linelength < 5 inches for paragraph 
decision (caused problems on documents with narrow paragraphs). ( 

3-Aug-88 10:03:47 upgraded to BWS4.3/VP2.0: numerous changes in DocInterchangeDefs and company; added 
session support because of DocInterchangeDefs.FinishCreation. 

/ 
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27-Apr-87 13:00:46 


deL.aBeaujardiere:OSBU North:Xerox (deLaBeaujardiere.PA) 
Copyright (C) 1986 by Xerox Corporation. All rights reserved. 
» 

DIRECTORY Containee, Environment, K4, NSFile, NSFi1eStream, 
Prototype, StarWindowShell, Stream, XString; 

K4FiledDatalmpl: PROGRAM 

IMPORTS NSFi1eStream, Stream, XString 
EXPORTS K4 = 

BEGIN 

OPEN XS: XString; 

<< = = := = = = = = = = PUBLIC PROCEDURES = = = = = = = = = = >> 


TypeAndVersion: PUBLIC PROCEDURE 

RETURNS [fileType: NSFile.Type, 

version: Prototype.Version] = 

BEGIN 

RETURN [7389325, -- randomly-chosen number for file type 

19 ]; -- current version of the application 

END; -- The file type must be assigned an 

-- official number at productization. 


LoadFiledData: PUBLIC PROCEDURE [parm: K4.IconParms] 

RETURNS [mismatch: BOOLEAN «- FALSE] = 

BEGIN 

--- This procedure loads into parm the names and values 

recorded in the icon file. Memory allocated here to hold 
the bytes for icon/folder/document names 
--- must be freed by the client. 

z: UNCOUNTED ZONE <- parm. heap; 
map, currentMap: K4.Mapping «- NIL; 
signature: CARDINAL *- Signature []; 

stream: Stream.Handle <- NSFileStream.Create [parm. iconFile, FALSE]; 
St ream.SetPosition [stream, 0]; 

BEGIN ENABLE St ream. EndOf St ream => (mismatch <- TRUE; 

GOTO Termination}; 

-- we should not run out of stream 

--- 1. Signature. 

parm.signature <- Stream.GetWord [stream]; 

IF parm.signature ft signature THEN (mismatch <- TRUE; 

GOTO Termination}; 

--- 2. General Properties 

parm. genProps <- parm. heap . NEW [K4.GeneralPropertyRecord]; 
parm. genProps . i conName *- LoadReaderBody [stream, z]; 
parm. genProps . channel Speed <- VAL[LoadEnumerated[stream]] ; 
parm, genProps . fol derName *■ LoadReaderBody [stream, z]; 
parm. genProps .others «- LoadReaderBody [stream, z]; 

-- 3. Document Properties 

parm, docProps «- parm. heap . NEW [K4 . DocumentPropertyRecord] ; 
parm. docProps . fol derName <- LoadReaderBody [stream, z]; 
parm.docProps .docName <- LoadReaderBody [stream, z]; 
parm.docProps.justification <- LoadBoolean [stream]; 
parm.docProps.lineHeight «- VAL[LoadEnumerated [stream]]; 
parm. docProps . preLeadi ng <- VAL[LoadEnumerated [stream]]; 
parm. docProps . postLeadi ng «- VAL[LoadEnumerated [stream]]; 
parm.docProps.under!ining <- VAL[LoadEnumerated [stream]]; 
parm.docProps .guessMark <- LoadReaderBody [stream, z]; 
parm.docProps .dropKeepMark <- VAL[LoadEnumerated [stream]]; 
parm. docP rops . pageBreak <- VAL[LoadEnumerated [stream]]; 
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pann. docProps . others «- LoadReaderBody [stream, z] ; 


— 4. String Mapping Properties 

parm.mapProps <- parm. heap .NEW [K4 .MapPropertyRecord <- [ 

header: LoadReaderBody [stream, z], 

number: Stream.GetWord [stream], 

map: NIL, 

tagSize: NIL]]; 

FOR k: CARDINAL IN [1..parm,mapProps.number] DO 
map «- parm. heap . NEW [K4.MappingRecord I- [ 
next: NIL, 

from: LoadReaderBody [stream, z], 
to: LoadReaderBody [stream, z] ]]; 

IF parm.mapProps.map = NIL 
THEN parm.mapProps.map ' map 
ELSE currentMap . next <- map; 
currentMap £ map; 

ENDLOOP; 

-- 5. Font Properties 

parm. fonProps <- parm. heap .NEW [K4. FontPropertyRecord] ; 

FOR k: CARDINAL IN [0. .9] DO 

parm.fonProps.fonts[k],font *- VAL[LoadEnumerated [stream]]; 
parm. fonProps . f on ts[k] . si ze <- VAL[LoadEnumerated [stream]]; 
parm. fonProps . f on ts[k] . i tal i cs *- LoadBoolean [stream]; 
parm.fonProps.fonts[k].bold <- LoadBoolean [stream]; 

ENDLOOP; 

EXITS Termination => {}; 

END; -- of ENABLE 

Stream.Delete [stream]; 

END; -- of LoadFi1edData 


StoreFiledData: PUBLIC PROCEDURE [parm: K4.IconParms] = 

BEGIN 

This procedure writed back into the icon file the values 
-- recorded in the property sheet. 

map: K4.Mapping «- parm. mapProps .map ; 

signature: CARDINAL <- Signat.ure[]; 

stream: Stream.Handle <- NSFileStream.Create [parm. i conFi 1 e , 

FALSE]; 

NSFileStream.SetLength [[stream], 0]; -- truncate old stream 

-- 1. Signature. 

Stream.PutWord [stream, signature]; 

-- 2. General Properties 

StoreReaderBody [stream, Qparm.genProps.iconName]; 
StoreEnumerated [stream, parm.genProps.channel Speed.ORD]; 
StoreReaderBody [stream, Qparm.genProps.folderName]; 
StoreReaderBody [stream, Qparm.genProps.others]; 

-- 3. Document Properties 

StoreReaderBody [stream, Qparm.docProps.folderName]; 
StoreReaderBody [stream, Qparm.docProps.docName]; 

StoreBoolean [stream, parm.docProps.justification]; 
StoreEnumerated [stream, parm.docProps.1ineHeight.ORD]; 
StoreEnumerated [stream, parm.docProps.preLeading.ORD]; 
StoreEnumerated [stream, parm.docProps.postLeading.ORD]; 
StoreEnumerated [stream, parm.docProps.under!ining .ORD]; 
StoreReaderBody [stream, Qparm.docProps.guessMark]; 
StoreEnumerated [stream, parm.docProps.dropKeepMark.ORD]; 
StoreEnumerated [stream, parm.docProps.pageBreak.ORD]; 
StoreReaderBody [stream, Qparm.docProps.others]; 

-- 4. Mapping Properties 

StoreReaderBody [stream, Qparm.mapProps.header]; 

Stream.PutWord [stream, parm.mapProps.number]; 

FOR k: CARDINAL IN [1..parm.mapProps.number] 

WHILE map # NIL DO -- should diagnose if map is NIL 
StoreReaderBody [stream, Qmap.from]; 

StoreReaderBody [stream, Qmap.to]; 
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map <- map.next; 
ENDLOOP; 


-- 5. Font Properties 

FOR k: CARDINAL IN [0..9] DO 

StoreEnumerated [stream, parm.fonProps.fonts[k],font.ORD]; 
StoreEnumerated [stream, parm.fonProps.fonts[k].size.ORD]; 
StoreBoolean [stream, parm.fonProps.fonts[k].italics]; 
StoreBoolean [stream, parm.fonProps.fonts[k].bold] ; 
ENDLOOP; 

Stream.SendNow [stream]; 

Stream.Delete [stream]; 

END; -- of StoreFi1edData 


FreelconProps: PUBLIC PROC [props: K4.General Properties, 

z: UNCOUNTED ZONE] = 

BEGIN 

IF props = NIL THEN RETURN; 

XS.FreeReaderBytes [@props.iconName, z]; 

XS.FreeReaderBytes [Qprops.folderName, z]; 

XS.FreeReaderBytes [@props.others, zj; 

IF props.tagSize # NIL THEN z.FREE [Qprops.tagSize]; 
z.FREE [Qprops]; 

END; -- of FreelconProps 


FreeTextProps: PUBLIC PROC [props: K4.DocumentProperties , 

z: UNCOUNTED ZONE] = 

BEGIN 

IF props = NIL THEN RETURN: 

XS.FreeReaderBytes [Qprops.folderName, z]; 

XS. FreeReaderBytes [Qprops.docName, zj; 

XS.FreeReaderBytes [Qprops.guessMark, z]; 

XS.FreeReaderBytes [Qprops.others, z]; 

IF props.tagSize # NIL THEN z.FREE [@props.tagSize] ; 
z.FREE [Qprops]; 

END; -- of FreeTextProps 


FreeMapProps: PUBLIC PROC [props: K4.MapProperties, 

z: UNCOUNTED ZONE] = 

BEGIN 

map, hold: K4.Mapping; 

IF props = NIL THEN RETURN; 

XS.FreeReaderBytes [Qprops.header, z]; 

FOR map «- props.map, hold WHILE map # NIL DO 
hold <- map.next; 

XS.FreeReaderBytes [Qmap.from, z]; 

XS.FreeReaderBytes [Qmap.to, z]; 
z.FREE [Qmap]; 

ENDLOOP; 

IF props.tagSize # NIL THEN z.FREE [Qprops.tagSize] ; 
z.FREE [Qprops]; 

END; -- of FreeMapProps 


FreeFontProps: PUBLIC PROC [props: K4.FontProperties, 

z: UNCOUNTED ZONE] = 

BEGIN 

IF props = NIL THEN RETURN; 

IF props.tagSize # NIL THEN z.FREE [Qprops.tagSize] ; 
z.FREE [Qprops]; 

END; -- of FreeFontProps 


«=, = = = = = = = = = PRIVATE PROCEDURES = = = = = = = = = = » 

LoadBoolean: PROC [stream: Stream.Handle] RETURNS [BOOLEAN] = 
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INLINE {RETURN [Stream.GetWord[stream] # 0]}; 


StoreBoolean: PROC [stream: Stream.Handle, boolean: BOOLEAN] = 
INLINE {Stream.PutWord [stream, boolean.ORD]}; 


LoadEnumerated: PROC [stream: St ream.Hand!e] 
RETURNS [Environment.Word] = 
INLINE {RETURN [Stream.GetWord[stream]]}; 


StoreEnumerated: PROC [stream: Stream.Handle, 

value: Environment.Word] = 
INLINE {Stream.PutWord [stream, value]}; 


LoadReaderBody: PROC [stream: Stream.Handle, z: UNCOUNTED ZONE] 
RETURNS [rb: XS.ReaderBody] = 

BEGIN 

length: CARDINAL <- Stream.GetWord [stream]; 

wb : XS.WriterBody «- XS.NewWriterBody [length, z]; 

TOR k: CARDINAL IN [0..length) DO 

XS.AppendChar [Swb, Stream.GetWord[stream]]; 

ENDLOOP: 

rb & XS.CopyToNewReaderBody[XS.ReaderFromWriter[@wb], z]; 

-- the bytes allocated here must be released by the client 

XS.F reeWrite rBytes[@wb]; 

END; 


StoreReaderBody: PROC [stream: St ream.Handle, r: XS.Reader] = 
BEGIN 

length: CARDINAL «- XS.CharacterLength[ r] ; 
lainbdaB: XS. ReaderBody <- XS.Dereference [r]; 

Stream.PutWord [stream, length]; 

FOR k: CARDINAL IN [0..length) DO 

Stream.PutWord [stream, XS.Lop[01ambdaB]]; 

ENDLOOP; 

END; 


Signature: PROC RETURNS [CARDINAL] = INLINE 

-- calculates some number likely to change whenever a change is 
made to K4. IconParmsRecord. This is to try to catch instances 
-- where the user has a Kurzweil icon not matching the current 
-- software version. 

{RETURN [ SIZE [K4.DocumentPropertyRecord] + 

3 * SIZE [K4.MapPropertyRecord] + 

5 * SIZE [K4.FontPropertyRecord] + 

7 * SIZE [K4.GeneralPropertyRecord] + 

11 * TypeAndVersion[].version]}; 


END. -- of K4FiledDataImpl 


10-Mar-87 9:47:45 

13- Mar-87 10:11:40 

16- Mar-87 9:43:36 

17- Mar-87 14:12:24 

19- Mar-87 10:55:28 

20- Mar-87 10:25:13 
3l-Mar-87 12:30:25 
prototype. 

31-Mar-87 13:21:36 

14- Apr-87 14:02:42 
24-Apr-87 16:15:03 
27-Apr-87 13:00:24 
/ 


created from code moved from K4IconImpl. 
added options and modified others, 
added signature, 
added character mapping, 
implemented TypeAndVersion. 

version 14: mapProps.number starts at 0 instead of 1. 

version 16: called ReduceList before writing map.number and only 

filed data initialization moved to K4IconImpl. 
version 17: paragraph properties. 

version 18: dropped canvas, moved fonts to separate prop sheet, 
version 19: folder name for transmissions, pageBreak choice. 


if 


not creating 
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delaBeaujardiere:OSBU North:Xerox (deLaBeaujardiere.PA) 
Copyright (C) 1986 by Xerox Corporation. All rights reserved. 


DIRECTORY Atom, Containee, 

Display, Environment, 

Heap, K4, 

NSFile, 

Prototype, 

SimpleTextDisplay, SimpleTextFont, 
StarWindowShel1, 

XChar, XString; 

K4IconImpl: PROGRAM 

IMPORTS Atom, Containee, Display, 

Heap, K4, NSFile, 

Prototype, 

SimpleTextDisplay, SimpleTextFont, 
XString = 

BEGIN 

OPEN XS: XString; 

<<===== TYPE DEFINITIONS AND CONSTANTS = = = = = » 

IconRecord: TYPE = RECORD [ 

heap: UNCOUNTED ZONE, 

oldGenericProc: Containee .GenericProc <- NIL, 

ke.yOpen: Atom. ATOM, 

keyProps: Atom.ATOM, 

small Icon: XS.Character t XChar.not]; 


«==== = = GLOBAL VARIABLES = = = = = » 
icon: LONG POINTER TO IconRecord < NIL; 


<<=, = = = = PROCEDURES = = = = = >> 


Instal1K4Icon: PROCEDURE = 

BEGIN 

heap: UNCOUNTED ZONE <- Heap .Create[ 1] ; 

rows: CARDINAL = 13; -- 13 rows in small icon picture 

small Picture: PACKED ARRAY[0 . . rows ) OF WORD <- [ 

177770B, 100010B, 125010B, 100010B, 177770B, 100010B, 137750B, 

U0110B, 170170B, 010100B, 010700B, 010600B, 017400B]; 
iconName: XS. ReaderBody <- XS. F romSTRING ["Kurzweil 4000"L]; 

impl : Containee.Implementation; 

iconFileType: NSFile.Type; 
currentVersion: Prototype.Version; 

[iconFileType, currentVersion] «- K4.TypeAndVersion[]; 
icon ¥ heap.NEW[IconRecord]; 
icon.heap *■ heap; 

icon.keyOpen <- Atom.MakeAtom["Open"L]; 
icon.keyProps < Atom.MakeAtom["Props"L]; 

IF Prototype.Find [type: iconFileType, 

version: currentVersion] = NSFi1e.null Reference THEN 
MakeNewVersion [©iconName, iconFileType, currentVersion, heap]; 

impl *■ Containee.Getlmplementation [iconFileType]; 

icon.oldGenericProc «- impl . generi cProc ; 

icon.smalllcon «- SimpleTextFont. AddCl ientDef inedCharacter[ 

width: 13, 
height; rows, 
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bitsPerLine: 16, 
bits: @smal1 Picture] ; 


imp! .genericProc <- GenericProc; 
impl.name <- iconName; 

impl . small Pi ctureProc «- PaintSmallIcon; 
impl.pictureProc <- PaintBiglcon; 

[] <- Containee.Setlmplementation [iconF ileType, impl]; 
END; -- of InstallK4Icon 


MakeMewVersion: PROC [iconName: XS.Reader, 

iconType: NSFile.Type, 
iconVersion: Prototype.Version, 
z: UNCOUNTED ZONE] = 

BEGIN 

question: LONG STRING <- "0"L; 

parm: K4,IconParms «- z . NEW[K4. IconParmsRecord] ; 
parm.heap <- z; 

parm.genProps <- z.NEW [K4.GeneralPropertyRecord <- [ 
iconName: iconName^, 

channelSpeed: ninetySix, 

folderName: XS. FromSTRING ["Kurzweil Transmissions"L] , 

others: XS.FromSTRING [ 

"Bits per Char: 8, Stop bits: 1, Parity: None, Asynchronous"L]]]; 
parm, docP rops «- z.NEW [K4 . DocumentPrope rtyRecord «- [ 

folderName: XS.FromSTRING ["Kurzweil Documents"L] , 

docName: XS.FromSTRING ["Interpreted Document"L], 

justification: TRUE, 

1ineHeight: single, 

preLeading: single, 

postLeading: singleHalf, 

underlining: underline, 

guessMark: XS.FromSTRING [question], 

dropKeepMark: drop, 

pageBreak: drop, 

others: XS.FromSTRING [ 

"End Line: HOD, End Page: HOC, End Column/Para: None, Horizontal: Preserve, Vertical: 

Preserve Breaks"L]]]; 

parm.mapProps «- z.NEW [K4.MapPropertyRecord < [ 

header: XS.FromSTRING ["Character Substitutions"L], 

number: 0, 

map: NIL]]; 

parm. fonProps <- z.NEW [K4. FontPropertyRecord «- [ 

fonts: [[classic, ten, FALSE, FALSE], 

[classic, ten, FALSE, TRUE ], 

[classic, ten, TRUE, FALSE], 

[classic, eight, FALSE, FALSE], 

[classic, eight, FALSE, TRUE ], 

[classic, eight, TRUE, FALSE], 

[classic, twelve, FALSE, FALSE], 

[classic, twelve, FALSE, TRUE ], 

[classic, twelve, TRUE, FALSE], 

[classic, fourteen, FALSE, FALSE]]]]; 

parm. iconFi 1 e <- Prototype.Create [name: iconName, 

type: iconType, 
subtype: 0, 
version: iconVersion, 
isDirectory: FALSE]; 

Prototype.PurgeOldVersions [type: iconType, 

subtype: 0, 

current: iconVersion]; 

K4.StoreFiledData [parm]; 
z. .FREE [Sparm.genProps]; 
z.FREE [Sparm.docProps]; 
z.FREE [Qparm.mapProps] ; 
z.FREE [Qparm.fonProps] ; 

NSFile.Close [parm.iconFi1e]; 
z.FREE [Qparm]; 

END; -- of MakeNewVersion 


GenericProc: Containee.GenericProc = 
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defined as PROC [atom: Atom.ATOM, 
data: DataHandle, 
changeProc: ChangeProc «- NIL, 
changeProcData: LONG POINTER <- NIL, 

RETURNS [LONG UNSPECIFIED] 

BEGIN 

shell: LONG POINTER; 

shell <- SELECT atom FROM 

icon.keyOpen => K4.OpenWindow [data, changeProc, 

changeProcData, 
icon.smal1 Icon], 

icon.keyProps => K4,0penPSheet [data, changeProc, 

changeProcData], 

ENDCASE => icon.oldGenericProc [atom, data, changeProc, 

changeProcData]; 

RETURN [shell]; 

END; -- of GenericProc 


Err; PR0CEDURE[message: LONG STRING] = BEGIN 

msgRB: XString.ReaderBody <- XStri ng . FromSTRING[message] ; 
Containee.Error [SmsgRB]; 

END; -- of Err 


PaintSmallIcon: Containee.Smal1PictureProc = {RETURN[icon.smal1 Icon]}; 


PaintBiglcon : Containee.PictureProc = BEGIN 
widthlnPixels: CARDINAL = 65; 
widthlnWords: CARDINAL = 5; 
heightlnPixels: CARDINAL = 60; 

IF new=garbage THEN RETURN 
ELSE BEGIN 

fileName: XS.ReaderBody; 

cacheTicket: Containee.Ticket; 

mask: ARRAY[0. .widthInWords*heightInPixels) OF WORD «- [ 
037777B, 177777B, 177777B, 177776B, OOOOOOB, 

077777B, 177777B, 177777B, 177777B, OOOOOOB, 

177777B, 177777B, 177777B, 177777B, 100000B, 

177777B, 177777B, 177777B, 177777B, 100000B, 

177777B, 177777B, 17777/B, 177777B, 100000B, 

177777B, 177777B, 177777B, 177777B, 100000B, 

177777B, 177777B, 177777B, 177777B, 100000B, 

177777B, 177777B, 177777B, 177777B, 100000B, 

177777B, 177777B, 177777B, 177777B, 100000B, 

177777B, 177777B, 177777B, 177777B, I00000B, 

177777B, 177777B, 177777B, 177777B, 100000B, 

177777B, 177777B, 177777B, 1777776, 100000B, 

177777B, 177777B, 177777B, 177777B, 100000B, 

177777B, 177777B, 177777B, 177777B, 100000B, 

177777B, 177777B, 177777B, 177777B, 100000B, 

177777B, I77777B, 177777B, 177777B, 100000B, 

177777B, I77777B, 177777B, 177777B, 100000B, 

177777B, 177777B, 177777B, 177777B, 100000B, 

177777B, 177777B, 177777B, 177777B, 100000B, 

1 77777B, 177777B, 177777B, 177777B, 100000B, 

177777B, 177777B, 177777B, 177777B, 100000B, 

177777B, 177777B, 177777B, 177777B, 100000B, 

177777B, 177777B, 177777B, 177777B, 100000B, 

177777B, 177777B, 177777B, 177777B, 100000B, 

177777B, 177777B, 177777B, 177777B, I00000B, 

177777B, 177777B, 177777B, 177777B, lOOOOOB, 

177777B, 177777B, 177777B, 177777B, lOOOOOB, 

177777B, 177777B, 177777B, 177777B, lOOOOOB, 

177777B, 177777B, 177777B, 177777B, lOOOOOB, 

177777B, 177777B, 177777B, 177777B, lOOOOOB, 

177777B, 177777B, 177777B, 177777B, lOOOOOB, 

177777B, 177777B, 177777B, 177777B, lOOOOOB, 

177777B, 177777B, 177777B, 177777B, lOOOOOB, 

177777B, 177777B, 177777B, 177777B, lOOOOOB, 

077777B, 177777B, 177777B, 177777B, OOOOOOB, 

037777B, 177777B, 177777B, 177776B, OOOOOOB, 

000077B, 177777B, 177777B, 177000B, OOOOOOB, 
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000077B, 177777B, 177777B, 177000B, OOOOOOB, 

000077B, 177777B, 177777B, 177000B, OOOOOOB, 

000077B, 177777B, 177777B, 177000B, OOOOOOB, 

000077B, 177777B, 177777B, 177000B, OOOOOOB, 

000077B, 177777B, 177777B, 177000B, OOOOOOB, 

000077B, 177777B, 177777B, 177000B, OOOOOOB, 

000077B, 177777B, 177777B, 177000B, OOOOOOB, 

000077B, 177777B, 177777B, 177000B, OOOOOOB, 

000077B, 177777B, 177777B, 177000B, OOOOOOB, 

000077B, 177777B, 177777B, 177000B, OOOOOOB, 

000077B, 177777B, 177777B, 177000B, OOOOOOB, 

000077B, 177777B, 177777B, 177000B, OOOOOOB, 

000077B, 177777B, 177777B, 177000B, OOOOOOB, 

000077B, 177777B, 177777B, 177000B, OOOOOOB, 

000077B, 177777B, 177777B, 177000B, 071145B, 

000077B, 177777B, 177777B, 176000B. 00002ZB, 

000077B, 177777B, 177777B, 174000B, 007144B, 

000077B, 177777B, 177777B, 170000B, 0000226, 

000077B, 177777B, 177777B, 160000B, 002312B, 

000077B, 177777B, 177777B, 140000B, 000005B, 

000077B, 177777B, 177777B, 100000B, 000005B, 

000077B, 177777B, 177777B, OOOOOOB, 000025B, 

000077B, 177777B, 177776B, OOOOOOB, 064556B]; 

IF new= ref erence OR new=referenceHighl ighted THEN new <- normal; 

box.place.x <- box.place.x + 2; 

box.dims.w <- wi dthl nPi xel s; 

box,place.y <- box.place.y + 8; 

box.dims.h <- hei ghtl nP i xel s; 

Display.Bitmap[ 
window: window, 
box: box, 

address: [word: Smask, bit: 0], 

bitmapBitWidth: widthInWords*Environment,bitsPerWord, 
flags: SELECT new FROM 

highlighted, referenceHighlighted => [ --for inverting picture 
disjoint: TRUE, 
srcFunc ; nul1 , 
dstFunc: or], 

ENDCASE => [ 

disjoint: TRUE, 
srcFunc; complement, 
dstFunc: and]]; 

IF new#ghost THEN BEGIN 

picture: ARRAY[0. ,widthInWords*heightInPixels) OF WORD *- [ 
037777B, 177777B, 177777B, 177776B, OOOOOOB, 

077777B, 177777B, 177777B, 177777B, OOOOOOB, 

160000B, OOOOOOB, OOOOOOB, 000003B, 100000B, 

140000B, OOOOOOB, OOOOOOB, 000001B, 100000B, 

140000B, OOOOOOB, OOOOOOB, 000001B, 100000B, 

140000B, OOOOOOB, OOOOOOB, 000001B, 100000B, 

140000B, OOOOOOB, OOOOOOB, 000001B, 100000B, 

140000B, OOOOOOB, OOOOOOB, 000001B, 100000B, 

140000B, OOOOOOB, OOOOOOB, 000001B, 100000B, 

140000B, OOOOOOB, OOOOOOB, 000001B, 100000B, 

140000B, OOOOOOB, OOOOOOB, 000001B, 100000B, 

140000B, OOOOOOB, OOOOOOB, 000001B, 100000B, 

140000B, OOOOOOB, OOOOOOB, 000001B, 100000B, 

140000B, OOOOOOB, OOOOOOB, 000001B, 100000B, 

140000B, OOOOOOB, OOOOOOB, 000001B, 100000B, 

140000B, OOOOOOB, OOOOOOB, 000001B, 100000B, 

140000B, OOOOOOB, OOOOOOB, 000001B, 100000B, 

140000B, OOOOOOB, OOOOOOB, 000001B, 100000B, 

140000B, OOOOOOB, OOOOOOB, 000001B, 100000B, 

140000B, OOOOOOB, OOOOOOB, 000001B, 100000B, 

140000B, OOOOOOB, OOOOOOB, 000001B, 100000B, 

177777B, 177777B, 177777B, 177777B, 100000B, 

140000B, OOOOOOB, OOOOOOB, 000001B, 100000B, 

140000B, OOOOOOB, OOOOOOB, 000001B, 100000B, 

140000B, OOOOOOB, OOOOOOB, 000001B, 100000B, 

140000B, OOOOOOB, OOOOOOB, 000001B, 100000B, 

140000B, OOOOOOB, OOOOOOB, 000001B, 100000B, 

141777B, 177777B, 177777B, 177 74 IB, 100000B, 

141760B, OOOOOOB, OOOOOOB, 003741B, 100000B, 
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140020B, OOOOOOB, OOOOOOB, 002001B, lOOOOOB, 

140020B, 052525B, 052525B, 002001B, lOOOOOB, 

140020B, 025252B, 125252B, 002001B, lOOOOOB, 

140020B, OOOOOOB, OOOOOOB, 002001B, lOOOOOB, 

160020B, OOOOOOB, OOOOOOB, 002003B, lOOOOOB, 

077760B, 052525B, 052525B, 003777B, OOOOOOB, 

037760B, 025252B, 125252B, 003776B, OOOOOOB, 

000060B, OOOOOOB, OOOOOOB, 003000B, OOOOOOB, 

000060B, OOOOOOB, OOOOOOB, 003000B, OOOOOOB, 

000060B, 052525B, 052525B, 003000B, OOOOOOB, 

0000608, 025252B, 125252B, 003000B, OOOOOOB, 

000060B, OOOOOOB, OOOOOOB, 003000B, OOOOOOB, 

OOOOOOB, OOOOOOB, OOOOOOB, 003000B, OOOOOOB, 

000060B, 052525B, 052525B, 003000B, OOOOOOB, 

OOOOOOB, 025252B, 125252B, 003000B, OOOOOOB, 

OOOOOOB, OOOOOOB, OOOOOOB, 003000B, OOOOOOB, 

OOOOOOB, OOOOOOB, OOOOOOB, 003000B, OOOOOOB, 

000060B, 052525B, 052525B, 003000B, OOOOOOB, 

OOOOOOB, 025252B, 125252B, 003000B, OOOOOOB, 

OOOOOOB, OOOOOOB, OOOOOOB, 003000B, OOOOOOB, 

OOOOOOB, OOOOOOB, OOOOOOB, 003000B, OOOOOOB, 

000060B, OOOOOOB, OOOOOOB, 003000B, OOOOOOB, 

000060B, OOOOOOB, 000007B, 177000B, OOOOOOB, 

OOOOOOB, OOOOOOB, 000004B, 016000B, OOOOOOB, 

000060B, OOOOOOB, 000004B, 034000B, OOOOOOB, 

000060B, OOOOOOB, 000004B, 070000B, OOOOOOB, 

000060B, OOOOOOB, 000004B, 160000B, OOOOOOB, 

000060B, OOOOOOB, 000005B, 140000B, OOOOOOB, 

000060B, OOOOOOB, 000007B, lOOOOOB, OOOOOOB, 

000077B, 177777B, 177777B, OOOOOOB, OOOOOOB, 

000077B, 177777B, 177776B, OOOOOOB, OOOOOOB]; 

Display.Bitmap[ 
window: window, 
box: box, 

address: [word: ©picture, bit: 0], 

bitmapBitWidth: widthlnWords*Environment.bitsPerWord, 
flags: SELECT new FROM 

highlighted, referenceHighlighted => [ 
disjoint: TRUE, 
srcFunc: complement, 
dstFunc: and], 

ENDCASE => [ 
disjoint: TRUE, 
srcFunc : nul1, 
dstFunc: on]]; 

END; --of drawing in the picture per se (not a ghost) 

[fileName, cacheTicket] «- Contai nee .GetCachedName[data] ; 

['] «- SimpleTextDisplay.StringIntoWindow[ 
string: ©fileName, 
window: window, 

place: [x: box.place.x + 3, y: box.place.y + 3], 
lineWidth: widthlnPixels - 6, 
maxNumberOfLines: 1, 
wordBreak: FALSE, 
flags: SELECT new FROM 

hiqhliqhted, referenceHighlighted => [ 
disjoint: TRUE, 
srcFunc: complement, 
dstFunc: and], 

ENDCASE => Display.paintFlags]; 

Containee.ReturnTicket[cacheTicket]; 

END; --of drawing; i.e., not garbage 
END; -- of PaintBiglcon 


« = = = = = = = = = = MAIN LINE CODE = = = = = = = = = = » 

I nstal1K4Icon[]; 

END. — of K4IconImpl 

14-Jan-87 15:03:40 created from DestTextlconlmpl. 
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6-Feb-87 15:35:08 changed initial preset of pSheet. 

10-Mar-87 9:50:14 removed Courier usage, moved Load/StoreFi1edData to K4FiledOatalmpl. 

19-Mar--87 11:05:26 used TypeAndVersion to get f ileType/version , 

31-Mar-87 13:50:53 moved initialization of icon main data store here from K4Fi1edDatalmpl. 
14-Apr-87 13:53:19 added paragraph properties. 

24-Apr-87 16:22:04 dropped canvas and ArtScan, moved fonts to separate prop sheet. 
27-Apr~87 13:05:58 foldername for transmissions, page break. 

/ 
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<< File: K4PSheetImpl.mesa 28-Apr-87 16:59:05 

del.aBeaujardiere :OSBU North:Xerox (deLaBeaujardiere.PA) 
Copyright (C) 1986 by Xerox Corporation. All rights reserved. 


DIRECTORY 

Attention, Containee, 

Environment, FormWindow, Heap, 

K4, 

NSFile, NSString, 

PropertySheet, 

SimpleTextDisplay, 

StarWindowShell, Window, XString; 

K4PSheetImpl: PROGRAM 

IMPORTS Attention, 

FormWindow, Heap, K4, NSFile, NSString, 
PropertySheet, 

SimpleTextDisplay, XString 

EXPORTS K4 = 

BEGIN 

OPEN FW: FormWindow, 

K4, 

XS: XString; 


«=jfc = = = = = = = PUBLIC PROCEDURES = = = = = = = = = = » 


OpenPSheet: PUBLIC PROCEDURE [iconData: Containee.DataHandle, 

changeProc: Containee.ChangeProc, 
changeProcData: LONG POINTER] 

RETURNS [StarWindowShell.Handle] = 

UNCOUNTED ZONE <- Heap.Create [1]; 

-- deleted by DoPropsCommands 
Window.Place «- PropertySheet. nul 1 PI ace; 

Window.Dims «- [0, 0]; 

XS. ReaderBody «- XS. F romSTRING [ 

"Kurzweil 4000 Properties"L]; 
versionMismatch: BOOLEAN; 

iconParms: K4.IconParms <- zone.NEW [K4. IconParmsRecord *- [ 

heap: zone, 
iconData: iconData, 
changeProc: changeProc, 
changeProcData: changeProcData, 
iconFile: NSFile.OpenByReference 

[iconData.reference] ]]; 

-- freed by TakeDownPSheet 

versionMismatch <- K4 . LoadFi 1 edData [iconParms]; 

-- unloaded by TakeDownPSheet 

IF versionMismatch THEN 
BEGIN 

Msg ["Obsolete icon does not work with new software”L]; 

NSFi1e.Close [iconParms.iconFi1e]; 
zone.FREE [OiconParms]; 

Heap.Delete [zone]; 

RETURN [StarWindowShel1.nullHandle]; 

END; 

--- Create the Property Sheet. 

iconParms . propSheet «- PropertySheet.CreateLinked [ 

1inkWindowlterns: MakeLinkProps, 

1inkWindowlternsLayout: LayLinkltem, 
formWindowItems : MakeTextProps , --- first shown 

formWindowltemsLayout: LayTextProps, -- is text sheet 


BEGIN 
zone: 

pSheetPlace 
pSheetSize: 
pSheetName: 
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menuItemProc: SetTextProps, 
menultems: [done: TRUE, cancel: TRUE], 
title: OpSheetName, 
size: pSheetSize, 
placeToDisplay: pSheetPlace, 
afterTakenDownProc: TakeDownPSheet, 
clientData: iconParms]; 

RETURN [iconParms,propSheet]; 

END; — of OpenPSheet 


OpenDocOptionSheet: PUBLIC PROC [ 

convertParm: K4.ConvertParms, 
takeDown: PropertySheet.MenuItemProc] = 

BEGIN 

pSheetName: XS.ReaderBody *• XS.FromSTRING ["Document Options"L]; 

pSize: Window.Dims <- [500, 400]; 

pPlace: Window.Place <- [500, 50]; 

convertParm. optionSheet <- PropertySheet.CreateLinked [ 

1inkWindowItems: MakeLinkOptions, 

1inkWindowItemsLayout: LayLinkltem, 

formWindowItems: MakeTextOptions, -- first shown 

formWindowItemsLayout: LayTextOptions, -- is text 

menuItemProc: SetTextOptions, 

menultems: [start: TRUE, cancel: TRUE], 

title; SpSheetName, 

size: pSize, 

placeToDisplay: pPlace, 

afterTakenDownProc: takeDown. 

clientData: convertParm]; 

END; -- of OpenDocOptionSheet 


« = = = = = = = = = = PRIVATE PROCEDURES FOR DOCUMENT SUBWINDOW = = = = = = = = = = >> 


MakeTextOptions: FW.MakeltemsProc = 

BEGIN 

parm: K4.ConvertParms <- L00PH0LE[cl ientData] ; 
MakeTextltems [window, parm.docProps, parm.zone]; 
END; -- of MakeTextOptions 


MakeTextProps: FW.MakeltemsProc = 

BEGIN 

iconParm: K4. IconParms <- LOOPHOLE[cl ientData] ; 
MakeTextltems [window, iconParm.docProps, iconParm.heap]; 
END; -- of MakeTextProps 


MakeTextltems: PROC [window: Window.Handle, 

docProps: K4.DocumentProperties, 
z: UNCOUNTED ZONE] = 

BEGIN 

label: XS.ReaderBody; 

unde rl i ni ngChoi ces : FW.Choiceltems «- DESCRIPTOR [uChoices]; 

uChoices: ARRAY [0..3) OF FW.Choiceltem <- [ 

[string [choiceNumber; Under!ining.underline.ORD, 

string: XString.FromSTRING["Underline"L]]], 
[string [choiceNumber: Underlining.italics.ORD, 

string: XString.FromSTRING["Italics"L]]], 
[string [choiceNumber: Underlining .plain.ORD, 

string: XString.FromSTRING["Plain"L]]] ]; 

lineChoices: FW.Choiceltems *- DESCRIPTOR [IChoices]; 

IChoices: ARRAY [0..4) OF FW.Choiceltem <- [ 

[string [choiceNumber: LineSpacing.single.ORD, 

string: XString.FromSTRING["Single"L]]], 
[string [choiceNumber: LineSpacing.singleHalf.ORD, 
string: XString.FromSTRING["1 1/2"L]]], 
[string [choiceNumber: LineSpacing.double.ORD, 


K4PSheetImpl.mesa 


28-Apr-87 16:59:07 PDT 


2 







string: XString.FromSTRING["Doubl e"L] ]], 

[string [choiceNumber: LineSpacing.triple.ORD, 

string: XString.FromSTRING["Tripie"L]]] ]; 

guessChoices: FW.Choiceltems < DESCRIPTOR [gChoices]; 

gChoices: ARRAY [0..2) OF FW.Choiceltem <- [ 

[string [choiceNumber: DropKeep.drop.ORD, 

string: XString.FromSTRING["Drop"L]]], 

[string [choiceNumber: DropKeep.keep.ORD, 

string: XString.FromSTRING["Keep"L]]] ]; 

pageBreakChoices: FW.Choiceltems <- DESCRIPTOR [pChoices]; 

pChoices: ARRAY [0..3) OF FW. Choi cel tern f? [ 

[string [choiceNumber: Under!ining.under!ine.ORD, 
string: XString.FromSTRING["None"L]]], 

[string [choiceNumber: Under!ining.italics.ORD, 

string: XString.FromSTRING["Every Page"L]]], 
[string [choiceNumber: Under!ining.p1ain.ORD, 

string: XString.FromSTRING["Unfi1 led Pages"L]]] ]; 

IF docProps.tagSize = NIL THEN 

docProps . tagSize *- z.NEW[TextTagSizes]; 

-- released by FreeTextProps 

docProps. tagSize[fol derName] <- Measure [@labe!, "Document Folder Name"L]; 

FW.MakeTextltem [window: window, myKey: K4.Textlterns.folderName.ORD, 
tag; @1abel, 

initString: OdocProps.folderName, 
width: 200]; 

docProps. tagSi ze[docName] <- Measure [Slabel, "Document Name"L]; 

FW.MakeTextltem [window: window, myKey: K4.Textlterns.docName.ORD, 
tag: @1abel, 

initString: QdocProps.docName, 
width: 200]; 

docProps . tagSi ze[ justification] «- Measure [Olabel, 

"Paragraph Right Edge"L]; 

FW.MakeBooleanItem[window: window, 

myKey: K4.Textltems.justification.ORD, tag: Slabel, 
label: [string [XString.FromSTRING["Justify"L]]]. 
initBoolean: docProps.justification]; 

docProps . tagSi ze[l ineHeight] v. Measure [Olabel, 

"Paragraph Line Heighf'L]; 

FW.MakeChoiceItem[window: window, 

rnyKey: K4. Textltems . 1 i neHeight .ORD, tag: @label, 

values: lineChoices, 

initChoice: VAL[docProps.lineHeight]]; 

docP rops . tagSi ze[preLead i ng] <- Measure [Slabel, 

"Lines before Paragraph"L]; 

FW.MakeChoiceltem[window: window, 

myKey: K4.Textltems.preLeading.ORD, tag: Olabel, 

values: lineChoices, 

initChoice: VAL[docProps.preLeading]]; 

docProps . tagSi ze[postLeadi ng] <- Measure [Qlabel, 

"Lines after Paragraph"L]; 

FW,MakeChoiceItem[window: window, 

myKey: K4.Textlterns.postLeading.ORD, tag: @label, 
values: lineChoices, 

initChoice: VAL[docProps.postLeading]]; 

docProps . tagSi ze[underl i ni ng] <- Measure [Qlabel, "Underl in i ng"L] ; 

FW.MakeChoi celtem[window: window, 

rnyKey: K4 . Textltems . underl i ni ng .ORD, tag: Slabel, 
values: underliningChoices, 
initChoice: VAL[docProps.underlining]]; 

docProps . tagSize[guessMark] *- Measure [@label, 

"Questionable Character"L]; 

FW.MakeTextltem [window: window, myKey: K4.Textlterns.guessMark.ORD, 
tag: @1abel, 

initString: QdocProps.guessMark, 
width: 40]; 
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FW,MakeChoiceItem[window: window, 

myKey: K4.Textltems.dropKeepMark.ORD, tag: NIL, 
values: guessChoices, 

initChoice: VAL[docProps.dropKeepMark]]; 

docProps.tagSize[pageBreak] <- Measure [©label, "Page Break"L]; 

FW,MakeChoiceltem[window: window, 

myKey: K4.Textlterns.pageBreak.ORD, tag: ©label, 
values: pageBreakChoices, 
i nitChoice: VAL[docProps.pageBreak]]; 

docProps . tagSi ze[others] *- Measure [©label, 

"Required Tailor Choices"L]; 

FW,MakeTextltem [window: window, myKey: K4.TextItems.others.ORD, 
tag: @1abel, 

initString: ©docProps.others , 

width: 300, boxed: FALSE, readonly: TRUE]; 

END; -- of MakeTextltems 


LayTextOptions: FW.LayoutProc = 

BEGIN 

parm: K4.ConvertParms «- L00PH0LE[cl ientData] ; 
LayTextltems [window, parm.docProps, parm.zone]; 
END; -- of LayTextOptions 


LayTextProps: FW.LayoutProc = 

BEGIN 

iconParm: K4,IconParms «- LOOPHOLE[cl i entData] ; 
L.ayTextltems [window, iconParm.docProps , iconParm. heap] ; 
END; -- of LayTextProps 


LayTextltems: PROC [window: Window.Handle, 

docProps: K4,DocumentProperties, 
z: UNCOUNTED ZONE] = 

BEGIN 

margin: CARDINAL = 5; 
maxTag: CARDINAL «- 0; 
line: FW.Line; 

ts : LONG POINTER TO TextTagSizes «- docProps . tagSi ze; -- accelerator 

L.aySingleltem: PROC [itemKey: K4 . Textltems, 

tagSize, interline: CARDINAL] = 

BEGIN 

IF interline > 0 THEN 

line «- FW.AppendLine[window: window, 
spaceAboveLine: interline]; 

FW.Appendltem[window: window, line: line, 
item: itemKey.ORD, 
preMargin: IF interline = 0 THEN 8 

ELSE Prespace[tagSize, maxTag, margin]]; 
END; -- of LaySingleltem 

FOR k: Textltems IN Textltems DO 
maxTag <- MAX [maxTag, ts[k]]; 

ENDLOOP; 

L.aySingleItem[folderName, ts[f ol derName] , 6]; 

L.aySingleItem[docName, ts[docName], 6]; 

L.aySingleItem[justif ication, ts[ j us t i f i cati on] , 6]; 

LaySingleltem[lineHeight, ts[lineHeight], 6]; 
L.aySingleItem[preLeading, ts[preLeading], 6]; 
L.aySingleItem[postLeading, ts[postLeading], 6]; 

LaySingleltem[underlining, ts[underlining], 6]; 

LaySingleItem[guessMark, ts[guessMark], 6]; 
L.aySingleItem[dropKeepMark, ts[dropKeepMark], 0]; 
LaySingleItem[pageBreak, ts[pageBreak], 6]; 

LaySingleItem[others, ts[others], 12]; 

FW.Repaint [window]; 

END; -- of LayTextltems 


SetTextOptions: PropertySheet.MenuItemProc = 
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BEGIN 

parm: K4.ConvertParms <- LOOPHOLE[clientData]; 

RETURN [SetTextltems [formWindow, parm.docProps, parm.zone]]; 
END; -- of SetTextOptions 


SetTextProps: PropertySheet.MenuItemProc - 
BEGIN 

iconParm: K4.IconParms «- L00PH0LE[clientData]; 

RETURN [SetTextltems [formWindow, iconParm.docProps, iconParm.heap]]; 
END; -- of SetTextProps 


SetTextltems; PROC [window: Window.Handle, 

docProps; K4.DocumentProperties, 
z: UNCOUNTED ZONE] 

RETURNS [BOOLEAN] = 

BEGIN 

Boolean: PROCEDURE [item; Textltems] RETURNS [BOOLEAN] = INLINE 
(RETURN [FW.GetBooleanltemValue [window, item.ORD]]}; 

Choice: PROCEDURE [item: Textltems] RETURNS [CARDINAL] = INLINE 
(RETURN [FW.GetChoiceltemValue [window, item.ORD] ]}; 

IF NOT FW.HasAnyBeenChanged [window] THEN RETURN [TRUE]; 

IF FW.HasBeenChanged [window, Textltems.folderName.ORD] THEN 
BEGIN 

docProps.folderName <- UpdateBody [window, 

Textltems.folderName.ORD, 

SdocProps.folderName, z]; 

IF XS.Empty [OdocProps.folderName] THEN 
BEGIN 

Msg ["Folder name cannot be empty"L]; 

RETURN [FALSE]; 

END; 

END; 

IF FW.HasBeenChanged [window, Textltems.docName.ORD] THEN 
BEGIN 

docProps.docName <- UpdateBody [ 

window, Textlterns.docName.ORD, 
SdocProps.docName, z]; 

IF XS.Empty [SdocProps.docName] THEN 
BEGIN 

Msg ["Document name cannot be empty"L]; 

RETURN [FALSE]; 

END; 

END; 

docProps .justification <- Boolean [K4 . Textlterns.justification]; 
docProps.lineHeight <- VAL [Choice [K4 . Textl terns . 1 i neHeight]] ; 

docP rops . preLeadi ng <- VAL [Choice [K4 . Textl terns . p reLead i ng] ] ; 

docProps.postLeading <- VAL [Choice [K4. Textltems. postLeading]]; 
docProps.underlining * VAL [Choice [K4.Textlterns.under!ining]]; 
docProps.dropKeepMark <- VAL [Choice [K4 . Textl terns . dropKeepMark]] ; 

docProps.pageBreak <- VAL [Choice [K4 . Textltems . pageBreak]] ; 

IF FW.HasBeenChanged [window, Textltems.guessMark.ORD] THEN 
docProps.guessMark *- UpdateBody [ 

window, Textltems.guessMark.ORD, 
QdocProps.guessMark, z'J; 

RETURN [TRUE]; 

END; -- of SetTextltems 


<<==== = = = = = = = PRIVATE PROCEDURES FOR MAPPING SUBWINDOW = = = = = = = = = = >> 

<< Road map to their usage: 

MakeMapOptions => MakeMapItems 

=> MakeNextMapItems 

MakeMapProps => MakeMapItems 

=> MakeNextMapItems 
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LayMapOptions 

LayMapProps 

AddNextMapOptions 

AddNextMapProps 


=> LayMapItems 
=> LayMapItems 
=> MakeNextMapItems 
=> LayNextMapItems 
=> MakeNextMapItems 
=> LayNextMapItems 


>> 


Mak.eMapOptions: FW.MakeltemsProc = 

BEGIN 

parm: K4.ConvertParms <- LOOPHOLE[cl i entData]; 

MakeMapItems [window, AddNextMapOptions. parm.mapProps, parm.zone]; 

-- If no mapping option exists yet, must display an empty pair 
IF parm.mapProps.number = 0 THEN 

MakeNextMapItems [window, AddNextMapOptions, 
parm.mapProps, parm.zone]; 

END; -- of MakeMapOptions 


MakeMapProps: FW.MakeltemsProc = 

BEGIN 

ip: K4.IconParms <- LOOPHOLE[cl ientData] ; 

MakeMapItems [window, AddNextMapProps, ip.mapProps. ip.heap]; 
IF ip.mapProps.number = 0 THEN 

MakeNextMapItems [window, AddNextMapProps, 
ip.mapProps, ip.heap]; 

END; -- of MakeMapProps 


MakeMapItems: PROC [window: Window.Handle, 

nextOut; FW . NextOutOfProc, 
mapProps: K4.MapProperties, 
z: UNCOUNTED ZONE] = 

BEGIN 

-- Create window items for the header and the 
-- existing from/to pairs, 
label: XS.ReaderBody; 

map: K4. Mapping <- mapProps .map; -- may be NIL if no items yet. 

IF mapProps.tagSize = NIL THEN 

mapProps.tagSize <- z.NEW[MapTagSizes]; -- released by FreeMapProps 

mapProps . tagSize[header] <- 0; 

FW.MakeTextltem[window: window, 
myKey: 0, 
tag: NIL, 

initString: OmapProps.header, 

width: 300, boxed: FALSE, readonly: TRUE]; 

mapProps . tagSi ze[f rom] «- Measure[@label, " "L]; 

mapProps .tagSize[to] «- 0; 

FOR k: CARDINAL IN [1..mapProps.number] DO 

FW.MakeTextItem[window: window, tag: Slabel, width: 50, 
myKey: 2*k - 1, initString: Smap.from]; 
FW.MakeTextItem[window: window, tag: NIL, width: 50, 
myKey: 2*k, initString: Omap.to, 
nextOutOfProc: nextOut]; 

map «- map , next; 

ENDLOOP; 

END; -- of MakeMapItems 


MakeNextMapItems: PROC [window: Window.Handle, 

nextOut: FW.NextOutOfProc, 
mapProps: K4.MapProperties, 
z: UNCOUNTED ZONE] = 

BEGIN 

-- Add an entry in mapProps, and create 
-- the corresponding pair of window items. 

empty: XS.ReaderBody *- XS. FromSTRING [""L]; 
map: K4.Mapping <- z.NEW [K4.MappingRecord «- [ 
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from: XS.CopyToNewReaderBody [Sempty, z], 
to: XS.CopyToNewReaderBody [Sempty, z], 

next: NIL]]; 

IF mapProps.map = NIL THEN mapProps.map ‘ map 

ELSE 

BEGIN 

F r OR last: K4.Mapping «- mapProps.map, last.next DO 
IF last.next = NIL THEN {last.next <- map; EXIT); 

ENDLOOP; 

END; 

mapProps . number <- mapProps . number + 1; -- update number of pairs 

FW.MakeTextItem[window: window, tag: NIL, width: 50, 
myKey: 2*mapProps.number - 1, 
initString: Omap.from]; 

FW.MakeTextltem[window: window, tag: NIL, width: 50, 
myKey: 2*mapProps.number, 
initString: Omap.to, 
nextOutOfProc: nextOut]; 

END; -- of MakeNextMapItems 


LayMapOptions: FW.LayoutProc = 

BEGIN 

parm: K4.ConvertParms <- L00PH0LE[clientData]; 
LayMapItems [window, parm.mapProps, parm.zone]; 
END; -- of LayMapOptions 


LayMapProps: FW.LayoutProc = 

BEGIN 

iconParm: K4.IconParms *- LOOPHOLE[cl ientData] ; 
LayMapItems [window, iconParm.mapProps, iconParm.heap]; 
END; -- of LayMapProps 


LayMapItems: PROC [window: Window.Handle, 

mapProps: K4.MapProperties, 
z: UNCOUNTED ZONE] = 

BEGIN 

margin: CARDINAL = 5; 
spaceBetweenLines: CARDINAL = 3; 
preMargin, maxTag: CARDINAL <- 0; 
line: FW.Line; 

FOR k: Mapltems IN Mapltems DO 

rnaxTag «- MAX [maxTag, mapProps . tagSize[k]] ; 

ENDLOOP; 

line «- FW. AppendLi ne[window: window, 

spaceAboveLine: 2 * spaceBetweenLines]; 
FW,AppendItem[window: window, line: line, 
item: K4.Mapltems.header,ORD, 

preMargin: Prespace[mapProps,tagSize[K4.Mapltems.header], 
maxTag, margin]]; 

preMargin Prespaca[mapProps . tagSi ze[K4 .Mapltems . f rom] , 

maxTag, margin]; 

FOR k: CARDINAL IN [1..mapProps.number] DO 
line *- FW.AppendLine[window: window, 

spaceAboveLine: 2 * spaceBetweenLines]; 
FW.AppendItem[window: window. Tine: line, 

item: 2*k - 1, preMargin: preMargin]; 

FW.Appendltem[window: window, Tine: Tine, 
item: 2*k, preMargin: 8]; 

ENDLOOP; 

FW.Repaint [window]; 

END; -- of LayMapItems 


LayNextMapItems: 
BEGIN 


PROC [window: Window.Handle, 

mapProps: K4.MapProperties] = 
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margin: CARDINAL = 5; 
spaceBetweenLines: CARDINAL = 3; 
preMargin: CARDINAL; 
maxTag: CARDINAL <- 0; 
line: FW.Line; 

lastTo: FW.ItemKey <- 2*mapProps.number; 

FOR k: Mapltems IN Mapltems DO 

maxTag <- MAX [maxTag, mapProps.tagSize[k]]; 

ENDLOOP; 

line <- FW,AppendLine[window: window, 

spaceAboveLine: 2 * spaceBetweenLines]; 
preMargin <- Prespace[mapProps . tagSi ze[K4 .Mapltems . from] , 
maxTag, margin]; 

FW.AppendItem[window: window, line: line, 

item: lastTo - 1, preMargin: preMargin]; 

FW.Appendltem[window: window, line: line, 
item: lastTo, preMargin: 8]; 

FW.Repaint [window]; 

END; -- of LayNextMapIterns 


AddNextMapOptions: FW.NextOutOfProc = 

BEGIN 

If NEXTing out of the last field, make and lay a new pair 

parm: K4 . Conve rtParms «- L00PH0LE[FW, GetCl i en tData [window]]; 

IF item = FW.NumberOfItems[window] THEN 
BEGIN 

MakeNextMapItems [window, AddNextMapOptions, 
parm.mapProps, parm.zone]; 
LayNextMapItems [window, parm.mapProps]; 

END; 

END; -- of AddNextMapOptions 


AddNextMapProps: FW.NextOutOfProc = 

BEGIN 

If NEXTing out of the last field, make and lay a new pair 

iconParm: K4.IconParms <-• LOOPHOLE[ FW. GetCl i entData [window]]; 

IF item = FW.NumberOfItems[window] THEN 
BEGIN 

MakeNextMapItems [window, AddNextMapProps, 

iconParm.mapProps, iconParm.heap]; 
LayNextMapItems [window, iconParm.mapProps]; 

END; 

END; -- of AddNextMapProps 


SetMapOptions: PropertySheet.MenuItemProc = 

BEGIN 

parm: K4 .ConvertParms «- LOOPHOLE[cl ientData] ; 

RETURN [SetMapItems [formWindow, parm.mapProps, parm.zone]]; 
END; -- of SetMapOptions 


SetMapProps: PropertySheet.MenuItemProc = 

BEGIN 

iconParm: K4 . IconParms +- LOOPHOLE[cl ientData] ; 

RETURN [SetMapItems [formWindow, iconParm.mapProps, iconParm.heap]]; 
END; -- of SetMapProps 


SetMapItems: PROC [window: Window.Handle, 

mapProps: K4.MapProperties, 
z: UNCOUNTED ZONE] RETURNS [BOOLEAN] 3 

BEGIN 

current, prior: K4.Mapping; 
itemFrom, itemTo: FW.ItemKey; 
emptyFrom, emptyTo: BOOLEAN; 

IF NOT FW.HasAnyBeenChanged [window] 
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OR mapProps = NIL THEN RETURN [TRUE]; 

current *• mapProps .map; 

FOR itemFrom <- 1, itemFrom + 2 
WHILE itemFrom < FW.NumberOfItems[window] DO 
itemTo *- itemFrom +1; 

IF FW.HasBeenChanged [window, itemFrom] THEN 

current.from «- UpdateBody [window, itemFrom, Ocurrent.from, z]; 
IF FW.HasBeenChanged [window, itemTo] THEN 

current.to «-■ UpdateBody [window, itemTo, Ocurrent.to, z]; 

empty From <- XS. Empty [@current,from]; 
emptyTo <- XS.Empty [Ocurrent.to]; 

SELECT TRUE FROM 

emptyFrom AND NOT emptyTo => 

BEGIN 

Msg ["Please Fill Left Field or clear Right Field"L]; 
FW.SetlnputFocus [window, itemFrom]; 

RETURN [FALSE]; 

END; 

empty From AND emptyTo -> 

BEGIN 

-- remove empty pair 

mapProps . number <- mapProps . number - 1; 

XS.FreeReaderBytes [Scurrent.from, z]; 

XS.FreeReaderBytes [Scurrent.to, z]; 

IF current = mapProps.map THEN -- empty pair is first 
BEGIN 

mapProps.map <- current.next; 
z.FREE [Qcurrent]; 
current «- mapProps .map : 
prior mapProps .map; 

END 

ELSE 

BEGIN 

prior.next «- current. next; 
z.FREE [Ocurrent]; 
current «- prior.next 
END; 

END; 

ENDCASE => 

BEGIN 

prior f current; 
current <■ current.next; 

END; 

ENDLOOP; 

RETURN [TRUE]; 

END; -- of SetMapItems 


<<========== PRIVATE PROCEDURES FOR FONT SUBWINDOW ==========>> 


MakeFontOptions: FW.MakeltemsProc = 

BEGIN 

parm: K4 . ConvertParms <- LOOPHOLE[cl i entData] ; 
MakeFontltems [window, parm.fonProps, parm.zone]; 
END; -- of MakeFontOptions 


MakeFontProps: FW.MakeltemsProc = 

BEGIN 

iconParm: K4.IconParms <- L00PH0LE[cl ientData] ; 
MakeFontltems [window, iconParm.fonProps, iconParm.heap]; 
END; -- of MakeFontProps 


MakeFontltems: 


BEGIN 


PROC [window: Window.Hand!e, 

fonProps: K4.FontProperties, 
z: UNCOUNTED ZONE] = 


K4PSheetImpl.mesa 


28-Apr-87 16:59:07 PDT 


9 







label: XS.ReaderBody; 

fontChoices: FW.Choiceltems «- DESCRIPTOR [fChoices]; 
fChoices: ARRAY [0..3) OF FW .Choi cel tern <- [ 

[string [choiceNumber: FontStyle.modern.ORD, 

string: XString.FromSTRING["Modern"L]]], 
[string [choiceNumber: FontStyle.classic.ORD, 

string: XString.F romSTRING["Clas sic"L]]], 
[string [choiceNumber: FontStyle.titan.ORD, 

string: XString.FromSTRING["Titan"L]]] ]; 

sizeChoices: FW.Choiceltems t DESCRIPTOR [sChoices]; 
sChoices: ARRAY [0..5) OF FW .Choi cel tern <- [ 

[string [choiceNumber: 0, 

string: XString . F romSTRING["8'’L]]] , 

[string [choiceNumber: 1, 

string: XString.F romSTRING["10"L]]], 
[string [choiceNumber: 2, 

string: XString.FromSTRING["12"L]]], 
[string [choiceNumber: 3, 

string: XString.F romSTRING['' 14"L]]] , 
[string [choiceNumber: 4, 

string: XString.FromSTRING["18"L]]] ]; 
MakeFontltems: PROC [fontNumber: CARDINAL, 

styleKey: K4.Fontltems, 
sizeKey: K4.Fontltems, 
italicsKey: K4.Fontltems, 
boldKey: K4.Fontltems] = 

BEGIN 

tagString: LONG STRING £ "Font x"L; 

tagString[tagStri ng . 1 ength - 1] ' 0 + VAL[f ontNumber] ; 

f onProps . tagSi ze[sty 1 eKey] <- Measure [Slabel, tagString]; 
fonProps.tagSize[sizeKey] *■ 0; 
fonProps.tagSize[boldKey] <- 0; 
fonProps.tagSize[italicsKey] ** 0; 

FW.MakeChoiceItem[ 

window: window, tag: Slabel, 
myKey: styleKey.ORD, 
fullyDisplayed: FALSE, 
values: fontChoices, 

initChoice: VAL[fonProps.fonts[fontNumber].font]]; 

FW.MakeChoiceltem[ 

window: window, tag: NIL, 
myKey: sizeKey.ORD, 
fullyDisplayed: FALSE, 
values: sizeChoices, 

initChoice: VAL[fonProps.fonts[fontNumber].size]]; 

FW.MakeBooleanltem[ 

window: window, tag: NIL, 
myKey: boldKey.ORD, 

label: [string [XString.FromSTRING["Bold"L]]], 
initBoolean: fonProps.fonts[fontNumber].bold]; 

FW.MakeBooleanItem[ 

window: window, tag: NIL, 
myKey: italicsKey.ORD, 

label: [string [XString.FromSTRING["Italics"L]]], 
initBoolean: fonProps.fonts[fontNumber].italics]; 

END; -- of MakeFontltems 


IF fonProps.tagSize = NIL THEN 

fonProps . tagSize «- z.NEW[FontTagSizes]; 

-- released by FreeFontProps 


MakeFontltems 

[0, 

fonto, 

sizeO, 

italicsO, 

boldO] 

MakeFontltems 

[1. 

fontl, 

sizel. 

i tal i cs 1, 

boldl] 

MakeFontltems 

[2, 

font2, 

size2. 

italics2, 

bold2] 

MakeFontltems 

[3, 

font3, 

size3. 

italics3. 

bold3] 

MakeFontltems 

[4, 

font4, 

size4. 

italics4. 

bold4] 

MakeFontltems 

[5, 

f ont5, 

size5. 

italics5. 

bold5] 

MakeFontltems 

[6, 

font6, 

size6, 

italics6, 

bold6] 

MakeFontltems 

[7, 

font7, 

size7, 

italics7. 

bold7] 

MakeFontltems 

[8, 

font8, 

size8. 

italics8, 

bold8] 

MakeFontltems 

[9, 

font9, 

size9, 

italics9, 

bold9] 


END; -- of MakeFontltems 
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LayFontOptions: FW.LayoutProc = 

BEGIN 

parm: K4.ConvertParms «- LOOPHOLE[clientData]; 
LayFontltems [window, parm.fonProps, parm.zone]; 
END; -- of LayFontOptions 


LayFontProps: FW.LayoutProc = 

BEGIN 

iconParm: K4.1conParms «- LOOPHOLE[cl ientData] ; 
LayFontltems [window, iconParm.fonProps, iconParm.heap]; 
END; -- of LayFontProps 


LayFontltems: PROC [window: Window.Handle, 

fonProps: K4.FontProperties, 
z: UNCOUNTED ZONE] = 

BEGIN 

margin: CARDINAL =5; 
maxTag: CARDINAL *- 0; 
line: FW.Line; 

ts: LONG POINTER TO FontTagSizes <- fonProps. tagSi ze; -- accelerator 

LaySingleltem: PROC [itemKey: K4.Fontltems, 

tagSize, interline: CARDINAL] = 

BEGIN 

IF interline > 0 THEN 

line *- FW.AppendLine[window: window, 
spaceAboveLine: interline]; 

FW.Appendltem[window: window, line: line, 
item: itemKey.ORD, 
preMargin: IF interline = 0 THEN 8 

ELSE Prespace[tagSize, maxTag, margin]]; 
END; -- of LaySingleltem 

FOR k: Fontltems IN Fontltems DO 

maxTag «- MAX [maxTag, fonProps . tagSize[k]] ; 

ENDLOOP; 

L.aySingleItem[fontO, ts[font0], 6]; 

L.aySingleItem[sizeO, ts[size0], 0]; 

LaySingleItem[italicsO, ts[italicsO], 0]; 

LaySingleItem[boldO, ts[bold0], 0]; 

L.aySi ngleItem[fontl, ts[fontl], 6]; 

LaySingleItem[sizel, ts[sizel], 0]; 

L.aySingleItem[ital icsl, ts[ital icsl] , 0]; 

L.aySingleItem[boldl, ts[boldl], 0]; 

LaySingleltem[font2, ts[font2], 6]; 

L.aySingleItem[size2, ts[size2], 0]; 

LaySingleItem[ital ics2, ts[italics2], 0]; 

L.aySingleItem[bold2, ts[bold2], 0]; 

L.aySingleItem[font3, ts[font3], 6]; 

L.aySingleItem[size3, ts[size3], 0]; 

L.aySing1eItem[ital ics3, ts[ital ics3] , 0]; 

L.aySingleItem[bold3, ts[bold3], 0]; 

L.aySingleItem[font4, ts[font4], 6]; 

LaySingleItem[size4, ts[size4], 0]; 

L.aySingl eltem[i tal ics4, ts[ i tal i cs4] , 0]; 

LaySingleItem[bold4, ts[bold4], 0]; 

LaySingleItem[font5, ts[font5], 6]; 

LaySingleItem[size5, ts[size5], 0]; 

LaySingleItem[italics5, ts[italics5], 0]; 

LaySingleItem[bold5, ts[bold5], 0]; 

LaySingleItem[font6, ts[font6], 6]; 

LaySingleltem[size6, ts[size6], 0]; 

LaySingleItem[italics6, ts[italics6], 0]; 

LaySingleItem[bold6, ts[bold6], 0]; 

LaySingleItem[font7, ts[font7], 6]; 

LaySingleItem[size7, ts[size7], 0]; 

LaySingleltem[italics7, ts[italics7], 0]; 

LaySingleItem[bold7, ts[bold7], 0]; 

LaySingleItem[font8, ts[font8], 6]; 

LaySingleltem[size8, ts[size8], 0]; 

LaySingleItem[italics8, ts[italics8], 0]; 

LaySingleItem[bold8, ts[bold8], 0]; 

LaySingleItem[font9, ts[font9], 6]; 
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LayFontOptions: FW.LayoutProc = 

BEGIN 

parm: K4.ConvertParms *- L00PH0LE[cl ientData] ; 
LayFontltems [window, parm. f onP rops , parm.zone]; 
END; -- of LayFontOptions 


LayFontProps: FW.LayoutProc = 

BEGIN 

iconParm: K4.IconParms «- LOOPHOLE[clientData]; 
LayFontltems [window, iconParm.fonProps, iconParm.heap]; 
END; -- of LayFontProps 


LayFontltems; PROC [window: Window.Handle, 

fonProps: K4.FontProperties, 
z: UNCOUNTED ZONE] = 

BEGIN 

margin: CARDINAL = 5; 
maxTag: CARDINAL <- 0; 
line: FW.Line; 

ts: LONG POINTER TO FontTagSizes «- fonProps. tagSize; -- accelerator 

LaySingleltem: PROC [itemKey: K4.Fontltems, 

tagSize, interline: CARDINAL] = 

BEGIN 

IF interline > 0 THEN 

line <- FW.AppendLine[window: window, 
spaceAboveLine: interline]; 

FW.Appendltem[window: window, line: line, 
item: itemKey.ORD, 
preMargin: IF interline = 0 THEN 8 

ELSE Prespace[tagSize, maxTag, margin]]; 
END; -- of LaySingleltem 

FOR k: Fontltems IN Fontltems DO 

maxTag «- MAX [maxTag, fonProps . tagSize[k]] ; 

ENDLOOP; 

LaySingleItem[fontO, ts[font0], 6]; 

LaySingleItem[sizeO, ts[size0], 0]; 

LaySingleltem[italicsO, ts[italicsO], 0]; 

LaySingleItem[boldO, ts[bold0], 0]; 

LaySing1eItem[fontl, ts[fontl], 6]; 

LaySingleItem[sizel, ts[sizel], 0]; 

LaySingleItem[italicsl, ts[italicsl], 0]; 

LaySingleItem[boldl, ts[boldl], 0]; 

LaySingleItem[font2, ts[font2], 6]; 

LaySingleltem[size2, ts[size2], 0]; 

LaySingleItem[italics2, ts[italics2], 0]; 

LaySingleltem[bold2 , ts[bold2], 0]; 

LaySingleItem[font3, ts[font3], 6]; 

LaySingleItem[size3, ts[size3], 0]; 

LaySingleItem[italics3, ts[italics3], 0]: 

LaySingleItem[bold3, ts[bold3], 0]; 

LaySingleItem[font4, ts[font4], 6]; 

LaySingleItem[size4, ts[size4], 0]; 

LaySingleItem[italics4, ts[ ital ics4], 0]; 

LaySingleltem[bold4, ts[bold4], 0]; 

LaySingleItem[font5, ts[font5], 6]; 

LaySingleItem[size5, ts[size5], 0]; 

LaySingleItem[italics5, ts[ital ics5], 0]; 

LaySingleItem[bold5, ts[bold5], 0]; 

LaySingleItem[font6, ts[font6], 6]; 

LaySingleltem[size6, ts[size6], 0]; 

LaySingleltem[italics6, ts[italics6], 0]; 

LaySingleItem[bold6, ts[bold6], 0]; 

LaySingleItem[font7, ts[font7], 6]; 

LaySingleItem[size7, ts[size7], 0]; 

LaySingleItem[italics7, ts[italics7], 0]; 

LaySingleItem[bold7, ts[bold7], 0]; 

LaySingleItem[font8, ts[font8], 6]; 

L.aySingleItem[size8, ts[size8], 0]; 

L.aySingleItem[ital ics8, ts[ital ics8] , 0]; 

L.aySingleItem[bold8, ts[bold8], 0]; 

L,aySingleItem[font9, ts[font9], 6]; 
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L.aySingleItem[size9, ts[size9], 0]; 
L.aySingl eltem[i tal ics9, ts[ ital i cs9] , 0]; 
L.aySingleltem[bold9, ts[bold9], 0]; 

FW.Repaint [window]; 

END; -- of LayFontltems 


SetFontOptions: PropertySheet.MenuItemProc = 

BEGIN 

parm: K4.ConvertParms <- LOOPHOLE[cl ientData] ; 

RETURN [SetFontltems [formWindow, parm.fonProps, parm.zone]]; 
END; -- of SetFontOptions 


SetFontProps; PropertySheet.MenuItemProc = 

BEGIN 

iconParm: K4.IconParms «- LOOPHOLE[clientData]; 

RETURN [SetFontltems [formWindow, iconParm.fonProps, iconParm.heap]]; 
END; -- of SetFontProps 


SetFontltems; PROC [window: Window.Handle, 

fonProps: K4.FontProperties, 
z: UNCOUNTED ZONE] 

RETURNS [BOOLEAN] = 

BEGIN 

Boolean: PROCEDURE [item: Fontltems] RETURNS [BOOLEAN] = INLINE 
(RETURN [FW.GetBooleanltemValue [window, item.ORD]]}; 

Choice: PROCEDURE [item: Fontltems] RETURNS [CARDINAL] = INLINE 
(RETURN [FW.GetChoiceltemValue [window, item.ORD] ]}; 

IF NOT FW.HasAnyBeenChanged [window] THEN RETURN [TRUE]; 

fonProps .fonts[0] .font «- VAL [Choice [K4 . Fontltems . fontO]] ; 
f onProps .f onts[0] .size <- VAL [Choice [K4 . FontIterns . sizeO]] ; 
fonProps .fonts[0] .bold «- Boolean [K4. Fontltems . boldO] ; 
fonProps .fonts[0] . ital ics <- Boolean [K4. Fontltems . i tal i csO] ; 
fonP rops . fonts[ 1] . font <- VAL [Choice [K4 . FontI terns . fontl] ] ; 

fonProps .fonts[l] .size <- VAL [Choice [K4 . FontI terns . sizel] ] ; 

f oriProps . f onts[l] .bold f Boolean [K4. Fontltems . bol d 1] ; 
fonProps . fonts[l] . ital ics «- Boolean [K4. Fontltems. ital i cs l] ; 
fonP rops . fonts[Z] . font <- VAL [Choice [K4 . Fontltems . font2] ] ; 

fonProps . fonts[2] . size «- VAL [Choice [K4 . FontI terns . size2] ] ; 

foriProps . fonts[2] .bold «- Boolean [K4 . Fontltems . bold2] ; 
f onProps . f onts[2] . i tal i cs «- Boolean [K4.FontIterns.italics2]; 
fonProps . fonts[3] . font <- VAL [Choice [K4 . Fontltems . font3]] ; 
fonProps.fonts[3].size <- VAL [Choice [K4 . Fontltems . si ze3]] ; 
fonProps . fonts[3] .bold <- Boolean [K4. Fontltems . bol d3] ; 
fonProps.fonts[3] .ital ics «- Boolean [K4. Fontltems . ital ics3] ; 
fonProps.fonts[4] .font <- VAL [Choice [K4 . FontI terns . font4] ] ; 
f onProps . fonts[4] . s i ze <- VAL [Choice [K4. Fontltems .size4]]; 
fonProps.fonts[4] .bold <- Boolean [K4 . FontI terns . bol d4] ; 
fonP rops . fonts[4] . i tal i cs <- Boolean [K4. FontI terns . i tal i cs4] ; 
fonProps . fonts[5] . font *- VAL [Choice [K4 . Fontltems . font5]] ; 
fonProps . fonts[5] . size <- VAL [Choice [K4 . Fontltems . s i ze5]] ; 
fonProps . fonts[5] .bold «- Boolean [K4 . Fontltems . boldS] ; 
fonProps .fonts[5] . ital ics ♦- Boolean [K4. Fontltems . i tal i cs5] ; 
fonProps ,fonts[6] .font <- VAL [Choice [K4 . FontI terns . font6] ] ; 

fonP rops . fonts[6] . si ze «- VAL [Choice [K4 . FontI terns . size6] ] ; 

fonProps . fonts[6] .bold <- Boolean [K4 . FontI terns . bol d6] ; 
fonProps .fonts[6] . ital ics *■ Boolean [K4. Fontltems . ital ics6] ; 
fonP rops . fonts[7] . font +■ VAL [Choice [K4. FontI terns . font7] ] ; 
fonProps.fonts[7] .size <- VAL [Choice [ K4 . Fon 1 1 terns . s i ze7] ] ; 
fonProps . fonts[7] .bold «- Boolean [K4 . Fontltems .bold7] ; 
fonProps . fonts[7] . i tal ics «- Boolean [K4. FontI terns . i tal i cs 7] ; 
fonProps . fonts[8] . font «- VAL [Choice [K4. Fontlterns . font8] ] ; 

fonProps . fonts[8] . size «- VAL [Choice [K4. Fontltems . si ze8] ] ; 

f onProps . fonts[8] . bold <- Boolean [K4. FontI terns . bol d8] ; 
fonProps . fonts[8] . ital ics <- Boolean [K4. FontI terns . i tal i cs8] ; 
fonP rops . fon ts[9] . font «- VAL [Choice [K4 . Fontltems . font9]] ; 
fonProps . fonts[9] .size «■ VAL [Choice [K4 . FontI terns . s i ze9] ] ; 
fonProps .fonts[9] .bold <- Boolean [K4.Fontltems.bold9]; 
fonProps .fonts[9] . ital ics <- Boolean [K4. Fontltems . i tal i cs9] ; 
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RETURN [TRUE]; 

END; -- of SetFontltems 


<<========== private PROCEDURES FOR GENERAL SUBWINDOW ==========>> 


MalceGeneral Items ; FW.MakeltemsProc = 

BEGIN 

iconParm: K4 , IconParms «- LOOPHOLE[cl ientData] ; 
label: XS.ReaderBody; 

speedChoices: FW.Choiceltems <- DESCRIPTOR [sChoices]; 
sChoices: ARRAY [0..3) OF FW .Choiceltem «- [ 

[string [choiceNumber: 0, 

string: XString.FromSTRING["9600"L]]], 

[string [choiceNumber: 1, 

string: XSt ring.F romSTRING["4800"L]]], 

[string [choiceNumber: 2, 

string: XString.FromSTRING["300"L]]] ]; 

IF iconParm.genProps.tagSize = NIL THEN 

i conParm.genProps .tagSize «- iconParm. heap . NEW[General TagSizes] : 

-- released by FreelconProps 

iconParm.genProps.tagSize[iconName] <- Measure[@label, "Icon Name"L]; 

FW.MakeTextltem[window: window, 

myKey: K4.GeneralItems.iconName.ORD, 
tag: ©label, 

initString: QiconParm.genProps.iconName, 
width: 200]; 

iconParm.genProps.tagSize[channelSpeed] <- Measure [©label, "RS232C Speed"L]; 
FW.MakeChoiceItem[window: window. 

myKey: K4.General I terns,channel Speed.ORD, tag: ©label, 
fullyDisplayed: FALSE, 
values: speedChoices, 

initChoice: VAL[iconParm.genProps.channelSpeed]]: 

i conParm. genP rops . tagSize[fol derName] <- Measure[@l abel, "Transmission Folder Name"L]; 
FW.MakeTextltem[window: window, 

myKey: K4.General Items.folderName.ORD, 
tag: @1abel, 

initString: ©iconParm.genProps.folderName, 
width: 200]; 

iconParm. genProps . tagSi ze[others] «- Measure[@l abel, "Required Tailor Choices"L]; 
FW.MakeTextItem[window: window, 

myKey: K4.General Items.others.ORD, 
tag: ©1abel, 

initString: @iconParm.genProps.others, 
width: 300, boxed: FALSE, readonly: TRUE]; 

END; -- of MakeGeneralItems 


LayGeneralI terns: FW.LayoutProc = 

BEGIN 

iconParm: K4. IconParms «- LOOPHOLE[cl ientData] ; 

margin: CARDINAL = 5; 

spaceBetweenLines: CARDINAL = 3; 

maxTag: CARDINAL <- 0; 

line: FW.Line; 

FOR k: K4.General Items IN K4.General Items DO 

maxTag <- MAX [maxTag, iconParm.genProps ,tagSize[k]] ; 

ENDLOOP; 

line <- FW.AppendLine[window: window, 

spaceAboveLine: 2 * spaceBetweenLines]; 

FW„Appendltem[ 

window: window, item: K4.General Items.iconName.ORD, line: line, 
preMargin: Prespace[iconParm.genProps.tagSize[iconName], maxTag, margin]]; 
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line <- FW.AppendLine[window: window, 

spaceAboveLine: 2 * spaceBetweenLines]; 

FW.Appendltem[ 

window: window, item: K4.General Items.channel Speed.ORD, line: line, 
preMargin: Prespace[iconParm.genProps.tagSize[channelSpeed], maxTag, margin]]; 

line <- FW .AppendLi ne[wi ndow: window, 

spaceAboveLine: 2 * spaceBetweenLines]; 

FW,Appendltem[ 

window: window, item: K4.General I terns.folderName.ORD, line: line, 
preMargin: Prespace[iconParm.genProps.tagSize[folderName], maxTag, margin]]; 

line *■ FW.AppendLine[window: window, 

spaceAboveLine: 4 * spaceBetweenLines]; 

FW.Appendltem[ 

window: window, item: K4.General Items.others.ORD, line: line, 
preMargin: Prespace[iconParm.genProps.tagSize[others], maxTag, margin]]; 

FW.Repaint [window]; 

END; -- of LayGeneralI terns 


SetGeneralI terns: PropertySheet.MenuItemProc = 

BEGIN 

nsSelections : NSF i 1 e . Sel ecti ons «- []; 
nsName: NSString.String; 

attributeList: ARRAY[0..1) OF NSFi1e.Attribute: 
ps : K4. IconParms «- L00PH0LE[clientData]; 

IF FW.HasBeenChanged [formWindow, General I terns.iconName.ORD] THEN 
BEGIN 

ps .genProps . iconName <- UpdateBody [formWindow, 

Generalltems.iconName.ORD, 

@ps.genProps.iconName, 
ps.heap]; 

IF XS.Empty [@ps.genProps.iconName] THEN 
BEGIN 

Msg ["Icon name cannot be empty"L]; 

RETURN [FALSE]; 

END; 

nsName <- XS . NSStri ngFromReader [Ops .genProps . iconName , ps.heap]; 
attributeList[0] «- [name [nsName]]; 

NSFile.ChangeAttributes [ps.icon File, DESCRIPTOR[attributeList]]; 
NSString.FreeString [ps.heap, nsName]; 

END; 

IF FW.HasBeenChanged [formWindow, General I terns.folderName.ORD] THEN 
BEGIN 

ps. genProps. folderName <- UpdateBody [formWindow, 

Generalltems.folderName.ORD, 
@ps.genP rops.folderName, 
ps.heap]; 

IF XS.Empty [Sps.genProps.folderName] THEN 
BEGIN 

Msg ["Folder name cannot be empty"L]; 

RETURN [FALSE]; 

END; 

END; 

ps . genProps . channel Speed <• VAL [FW.GetChoiceItemValue[ 

formWindow, 

K4 . General I terns.channel Speed.ORD]]; 

RETURN [TRUE]; 

END; -- of SetGeneralItems 


<<========== PRIVATE PROCEDURES FOR LINK SUBWINDOW ==========» 


MakeLinkOptions: FW.MakeltemsProc = 

BEGIN 

parm: K4 .ConvertParms *■ L00PH0LE[c1 ientData]; 
sheetChoi ces: FW.Choiceltems «- DESCRIPTOR [sChoices]; 
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sChoices: ARRAY [0..3) OF FW. Choi cel tern <- [ 

[string [choiceNumber: 0, 

string: XString.FromSTRING["Document"L]]], 
[string [choiceNumber: 1, 

string: XString.FromSTRING["Mapping"L]]], 
[string [choiceNumber: 2, 

string: XString.FromSTRING["Fonts"L]]] ]; 

MakeLinkltems [window, sheetChoices, 0, SwapOptions]; 

END; -- of MakeLinkOptions 


MakeLinkProps: FW.MakeltemsProc = 

BEGIN 

iconParm: K4.IconParms <- LOOPHOLE[cI ientData] ; 
sheetChoices: FW.Choiceltems <- DESCRIPTOR [sChoices]; 
sChoices: ARRAY [0..4) OF FW. Choi cel tem «- [ 

[string [choiceNumber: 0. 

string: XString.FromSTRING[ 11 Icon"L]]], 
[string [choiceNumber: 1, 

string: XString.FromSTRING["Document"L]]], 
[string [choiceNumber: 2, 

string: XString.FromSTRING["Mapping"L]]], 
[string [choiceNumber: 3, 

string: XString.FromSTRING["Font"L]]] ]; 

MakeLinkltems [window, sheetChoices, 1, SwapProps]; 

END; -- of MakeLinkProps 


MakeLinkltems: PROC [window: Window.Handle, 

choices: FW.Choiceltems, 
firstChoice: FW.ItemKey, 
swapProc: FW.ChoiceChangeProc] = 

BEGIN 

label: XS. ReaderBody XS. FromSTRING["Sheet for: "L]; 

FW.MakeChoiceItem[window: window, 

myKey : 0, tag: @1abel, 
values: choices, 
initChoice: firstChoice, 
changeProc: swapProc]; 

EiND; -- of MakeLinkltems 


LayLinkltem: FW.LayoutProc = 

BEGIN 

line: FW.Line *■ FW.AppendLine[window: window, 

spaceAboveLine: 9]; 

FW.AppendItem[window: window, item: 0, line: line, preMargin: 5]; 
END; -- of LayLinkltem 


SwapOptions: FW.ChoiceChangeProc = 

BEGIN 

parm: K4 .ConvertParms <- LOOPHOLE[FW.GetCl ientData [window]]; 

newMake: FW.MakeltemsProc; 

newLay: FW.LayoutProc; 

newSet: PropertySheet.MenuItemProc; 

SELECT newValue FROM 

0 => (newMake «- MakeTextOptions; 

newLay *■ LayTextOptions; 
newSet *■ SetTextOptions}; 

1 => (newMake «- MakeMapOptions; 

newLay <- LayMapOptions; 
newSet <- SetMapOpti ons} ; 

ENDCASE => (newMake <- MakeFontOptions; 

newLay *- LayFontOptions; 
newSet *■ SetFontOptions}; 

[] PropertySheet.SwapFormWindows [ 

shell: parm.optionSheet, 
apply: TRUE, 

newFormWindowlterns; newMake, 
newFormWindowItemsLayout: newLay, 
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newMenuItemProc: newSet]; 
END; -- of SwapOptions 


SwapProps: FW.ChoiceChangeProc = 

BEGIN 

iconParm: K4.IconParms <- LOOPHOLE[FW.GetCl ientData [window]]; 

newMake: FW.MakeltemsProc; 

newLay: FW.LayoutProc; 

newSet: Prope rtySheet.MenuItemProc; 

SELECT newValue FROM 

1 => (newMake <- MakeTextProps; 

newLay <- LayTextProps; 
newSet *- SetTextProps); 

2. => (newMake <- MakeMapProps; 

newLay *- LayMapProps; 
newSet +■ SetMapProps}; 

3 => (newMake *- MakeFontProps; 

newLay < LayFontProps; 
newSet <- SetFontProps}; 

ENDCASE => (newMake *- MakeGeneral Items ; 

newLay «- LayGeneral Items ; 
newSet *■ SetGeneral I terns}; 

[] <- PropertySheet.SwapFormWindows [ 

shell: iconParm.propSheet, 
apply: TRUE, 

newFormWindowItems: newMake, 
newFormWindowltemsLayout: newLay, 
newMenuItemProc: newSet]; 

END; -- of SwapProps 


TakeDownPSheet: PropertySheet.MenuItemProc = 

BEGIN 

data: Containee.Data; 
nsSel ections : NSFile.Selections «- []; 
iconParm: K4.IconParms «- LOOPHOLE[cl ientData] ; 
z: UNCOUNTED ZONE iconParm. heap; 

IF menultem = done TFIEN 
BEGIN 

IF i con P arm. map Props If NIL AND iconParm . mapProps . number = 1 THEN 
BEGIN -- check if only entry is empty 

IF XS.Empty [OiconParm.mapProps.map.from] 

AND XS.Empty [@iconParm.mapProps.map.to] 

THEN iconParm .mapProps . number <~ 0; 

END; 

K4.StoreFi1edData [iconParm]; 

IF iconParm.changeProc If NIL THEN 
BEGIN 

data «- [reference: NSFil e .GetReference[i conParm. iconFi 1 e]] ; 
nsSel ect i ons . i nterpreted[name] «- TRUE; 

iconParm.changeProc [changeProcData: iconParm.changeProcData, 
data: Odata, 

changedAttributes: nsSelections, 
noChanges: FALSE]; 

END; 

END; 

K4,FreelconProps [iconParm.genProps, z]; 

K4.FreeTextProps [iconParm.docProps, z]; 

K4.FreeMapProps [iconParm.mapProps, z]; 

K4.FreeFontProps [iconParm.fonProps, z]; 

NSFile.Close [iconParm.iconFi1e]; 
z.FREE [QiconParm]; 

Heap.Delete [z]; 

RETURN [TRUE]; 

END; -- of TakeDownPSheet 


«========== OTHER PRIVATE PROCEDURES ==========» 
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Measure: PR0CEDURE[1abel: XS.Reader, string: LONG STRING] 
RETURNS [size: CARDINAL] = 

(label* <- XS, FromSTRING[string] ; 
size «- SimpleTextDisplay.MeasureString[label].width}; 


Prespace: PROCEDURE [size, maxSize, margin: CARDINAL] 
RETURNS [preMargin: CARDINAL] = 

BEGIN 

preMarqin V marqin + (maxSize - size) + (IF size = 0 

THEN 8 ELSE 0); 

END; 


UpdateBody: PROC [window: Window.Handle, item: FW.ItemKey, 

oldReader: XS.Reader, zone: UNCOUNTED ZONE] 
RETURNS [newReaderBody: XS.ReaderBody] = 

BEGIN 

rb: XS. ReaderBody <- FW.LookAtTextltemValue [window, item]; 

XS.FreeReaderBytes [oldReader, zone]; 
newReaderBody ( XS.CopyToNewReaderBody [Orb, zone]; 
FW.DoneLookingAtTextltemValue [window, item]; 

END; -- of UpdateBody 


Msg: PROCEDURE [message: LONG STRING] = 

BEGIN 

msgRB: XS. Reade rBody «- XS. FromSTRING [message]; 
Attention.Post [QmsgRB]; 

END; -- of Msg 


END. -- of K4PSheetImpl 

14-Jan-87 15:42:32 created from DestTextPSheetlmpl . 

6- Feb-87 10:12:41 fixed storage leak (folderName/outputName not deallocated). 

12- Mar-87 13:48:25 made SetText/FontOptions PUBLIC. 

16- Mar-87 10:00:54 added signature. 

17- Mar-87 15:37:09 added character mapping. 

26- Mar-87 11:27:35 made channel speed singly-displayed. 

3l-Mar~87 14:12:20 changes to StoreFiledData, no longer releasing memory. 
31-Mar-87 16:30:15 tried to fix nexting out of mappings. 

7- Apr-87 17:23:53 Taylor => Tailor. 

13- Apr-87 13:13:26 set mapProps.number to 0 if only entry is empty. 

14- Apr-87 14:32:18 added paragraph properties. 

20-Apr-87 17:45:17 initial value of channel speed not picked up from filed data. 
24-Apr-87 16:56:45 removed canvas property/option sheets. 

27- Apr-87 13:21:20 transmission folder name, page breaks. 

28- Apr-87 16:57:56 checked for empty icon, folder or document names 
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<< File: K4WindowImpl .mesa - 15-Sep-88 9:16:10 

deLaBeaujardiere:OSBU North:Xerox (deLaBeaujardiere.PA) 
Copyright (C) 1986 by Xerox Corporation. All rights reserved. 
>> 

DIRECTORY Attention, Containee, Environment, Heap, 

K4, MenuData, MessageWindow, 

NSFile, NSFileStream, NSString, Process, 

RS232C, RS232CCorrespondents, RS232CEnvironment, 
Selection, StarDesktop, StarFi1eTypes, 

StarWindowShel1, StarWindowShellExtra2, 

Stream, TIP, Window, XFormat, XString; 

K4Windowlmpl: MONITOR 

IMPORTS Attention, Heap, K4, MenuData, MessageWindow, 

NSFile, NSFileStream, NSString, 

Process, RS232C, Selection, 

StarDesktop, StarWindowShell, StarWindowShellExtra2, 
Stream, XFormat, XString 

EXPORTS K4 = 

BEGIN 

OPEN SWS: StarWindowShel1, XS: XString; 


Va 

Va 


riables: TYPE = LONG 
riableObject: TYPE = 
window: 
channel: 

commParamObject: 
data: 

windowclosing: 

1istener: 


POINTER TO VariableObject; 

RECORD [ 

Window.Hand!e , 
RS232C.ChannelHandle, 
RS232C.CommParamObject, 
RS232C.PhysicalRecord, 
BOOLEAN «- FALSE, 

PROCESS <- NIL]; 


parms: K4.IconParms; 
vars: Variables; 

bufferSize: CARDINAL = 512; 


OpenWindow: PUBLIC PROCEDURE [iconData: Containee.DataHandle, 

changeProc: Containee.ChangeProc, 
changeProcData: LONG POINTER, 
tinylcon: XS.Character] 


BEGIN 

RETURNS [shell: SWS.Handle *- SWS 

.nullHandle] = 

wDims: 

Window.Dims <- [500, 230]; 


wPlace: 

Window.Place *- [50, 30]; 


wLines: 

CARDINAL <- 10; 


mismatch: 

BOOLEAN; 


zone: 

UNCOUNTED ZONE Heap.Create [4]; --** why 4? 

-- deleted by ShellClosing 

reconvert 

: XString . ReaderBody «- XString . FromSTRING[ f 

'Make Document 

command: 

ARRAY[0. . 1) OF MenuData. ItemFlandl e <- [ 

MenuData.Create Item[ 



zone: 

zone, 


name: 

Oreconvert, 


p roc: 

Reconvert]]; 


--get memory for IconParms and fill it 
-- (freed by Shel1C1osing, unless there is 
a software/icon mismatch), 
parms * zone.NEW [K4.1 conParmsRecord]; 
parms. heap <- zone; 

parms . i con F i 1 e «- NSFile.OpenByReference [iconData. reference]; 

-- closed by ShellClosing 

mismatch <- K4.LoadFi1edData [parms]; -- unloaded by ShellClosing 
IF mismatch THEN 
BEGIN 


irtsg: XS. ReaderBody *• 
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"Obsolete icon does not work with new software"!.]; 
Attention.Post [@msg]; 

NSFile.Close [parms.iconFi1e]; 
zone.FREE [Oparms]; 

Heap.Delete [zone]; 

RETURN [SWS.nullHandle]; 

END; 

-- get memory for Variable 
-- (will be freed by ShellClosing). 
vars zone.NEW[VariableObject]; 

-- create window shell and message window 
shell <- SWS.Create [namePicture: tinylcon. 

name: Sparms.genProps.iconName, 
scroll Data: SWS.vanil1aScrol1 Data, 
isCloseLegalProc: ShellClosing]; 

SWS.SetRegularCommands [sws; shell, 

commands: MenuData.CreateMenu [ 
zone; zone, 
title: NIL, 

array: DESCRIPTOR[command]]]; 
vars.window <- SWS.CreateBody [shell]; 

StarWindowShel!Extra2.SetPreferredInteriorDims[sws: shell, 

dims; wDims]; 

MessageWindow.Create [vars.window, zone, wLines]; 

MsgDate []; 


ReadyRS232C [vars, parms.genProps.channel Speed]; 


vars . 1 i stener «- FORK GetTransmi ss i onAndConvert [vars, parms]; 
END; -- of OpenWindow 


Put Fi 

le! 

!nFo 

lder: PUBLIC PROCEDURE 

[file: NSFile 







fol derName: 

BEG 

IN 






- - 

Th¬ 

i s p 

roc puts 

a file 




in 

the 

named folder on 

the de 

sktop. 


If 

the 

folder 

is not f 

ound, a 

new one is c 


If 

the 

folde r 

creation 

fails. 

we leave the 

-- 

on 

the 

desktop 

as a last reso 

rt. . . 


.Handl e, 

NSStri ng . Stri ng] = 


reated. 
file 


dateOrdered; key NSFile.Ordering; 
folderFile; NSFile.Handle <- NSFi le , null Handle; 
folderAttrs: ARRAY [0..4) OF NSFi1e.Attribute; 
desktopFile: NSFi 1 e . Handl e <- NSFile. OpenByRef erence [ 
StarDesktop.GetCurrentDesktopFile []]; 


BEGIN 

folderAttrs[0] <- [name [folderName]]; 
folderFile < NSFile.Open [ 

attributes: DESCRIPTOR [BASE[folderAttrs], 1], 
directory: desktopFile 
! NSFile.Error => 

BEGIN 

WITH error SELECT FROM 

PI P P £» <1 <5 r "S 

SELECT problem FROM 
fileNotFound => 

BEGIN 

dateOrdered.ascending TRUE; 
dateOrdered . key *■ createdOn; 

folderAttrs[l] <- [type[StarFileTypes.folder]]; 
folderAttrs[2] <- [isDirectory [TRUE]]; 
folderAttrs[3] «- [ordering[dateOrdered]]; 
folderFile «- NSFile.Create [ 

directory: desktopFile, 

attributes: DESCRIPTOR[folderAttrs]]; 
StarDesktop.AddReferenceToDesktop [ 

NSFile.GetReferenee [folderFile]]; 

END; 

ENDCASE; 

ENDCASE; 

GOTO Done; 

END]; 

EXITS Done => {}; 
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E!ND; 

IF foIderFile = NSFile.nullHandle THEN -- folder creation failed 
StarDesktop.AddReferenceToDesktop[NSFile.GetReference [file]] 
ELSE 
BEGIN 

NSFile.Move [file, foIderFile]; 

NSFile.Close [foIderFile]; 

END; 

NSFile.Close [desktopFi1e]; 

END; -- of PutFilelnFolder 


-- PRIVATE PROCEDURES 


Shell Closing: ENTRY SWS.IsCloseLegalProc = 

BEGIN 

ENABLE UNWIND => NULL; 

z: UNCOUNTED ZONE; 

clearMask: RS232C.DeviceStatus <- [ 

statusAborted: FALSE, dataLost: FALSE, 
breakDetected; FALSE, clearToSend: TRUE, 
dataSetReady: TRUE, carrierDetect: TRUE, 
ringHeard: FALSE, ringlndicator: FALSE, 
deviceError: FALSE]; 

vars.windowClosing «- TRUE; 

IF vars.1istener # NIL THEN 
BEGIN 

RS232C.Suspend [vars.channel, all]; 

JOIN vars.1istener; 

RS232C.SetParameter [vars,channel, [latchBitClear [clearMask]]]; 
RS232C.Delete [vars.channel]; 
vars . 1 i stener <- NIL; 

END; 

IF parms.changeProc # NIL THEN parms.changeProc[ 

changeProcData: parms.changeProcData, 
data: parms.iconData, 
noChanges: TRUE]; 

MessageWindow.Destroy [vars.window]; -- clear message resources 

NSFile.Close [parms.iconFile]; 
z. <- parms. heap; 
z.FREE [@vars]; 

K4,FreelconProps [parms.genProps, z]; 

K4.FreeTextProps [parms,docProps, z]; 

K4,FreeMapProps [parms.mapProps, z]; 

K.4.FreeFontProps [parms.fonProps, z]; 
z.FREE [Qparms]; 

Heap.Delete [z]; 

RETURN[TRUE]; 

END; -- of ShellClosing 


Msg: PROC [message: LONG STRING, startOnNewLine: BOOLEAN] = 

BEGIN 

picture; XFormat. Object <- MessageWindow.XFormatObject [vars .wi ndow] ; 
IF startOnNewLine THEN 
BEGIN 

MessageWindow.PostSTRING [vars.window, " ”L, TRUE]; 

XFormat.Date [h: ©picture, format: timeOnly]; 

MessageWindow.PostSTRING [vars.window, " "L, FALSE]; 

END; 

MessageWindow.PostSTRING [vars.window, message, FALSE]; 

END; -- of Msg 


MsgDate: PROC = 

BEGIN 

<< 

pic: XFormat.Object «- MessageWindow.XFormatObject [vars .wi ndow] ; 
MessageWindow.PostSTRING [vars.window, " "L, TRUE]; 

XFormat.Date [h: @pic, format: dateOnly]; 
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» 

END; -- of MsgDate 


MsgDecimal: PROC [number: LONG CARDINAL] - 
BEGIN 

picture: XFormat.Object <- MessageWi ndow. XFormatObject [vars.window]; 
XFormat.Decimal [h: ©picture, n; number]; 

END; -- of MsgDecimal 


ReadyRS232C: PROCEDURE [vans: Variables, 

optionSpeed: K4.ChannelSpeed] = 


BEGIN 
speed: 


RS232C . LineSpeed <- SELECT optionSpeed 

ninetySix 
fortyEight 
three 
ENDCASE 


FROM 

=> bps9600, 
=> bps4800, 
=> bps300, 
=> bps9600; 


clearMask: RS232C.DeviceStatus *- [ 

statusAborted: FALSE, dataLost: FALSE, 
breakDetected: FALSE, clearToSend: TRUE, 
dataSetReady: TRUE, carrierDetect: TRUE, 
ringHeard; FALSE, ringlndicator: FALSE, 
deviceError: FALSE]; 
vars . commParamOb ject «- [duplex: full, 

lineType: asynchronous, 
lineSpeed: speed, 
accessDetai1: directConn[]]; 


vars.channel *■ RS232C .Create [ 

lineNumber: RS232C .GetNextLine [RS232C.nul1 LineNumber], 
commParams: @vars.commParamObject, 
preemptOthers: preemptAlways, 
preemptMe: preemptAlways]; 

RS2.32C .SetParameter [vars . channel , [charLength [8]]]; 

RS2.32C. SetParameter [vars. channel, 

[correspondent [RS232CCorrespondents.ttyHost]]]; 

RS232C.SetParameter [vars.channel, [frameTimeout [1000]]]; 

RS2.32C .SetParameter [vars . channel , [lineSpeed [speed]]]; 

RS2.32C .SetParameter [vars . channel , [parity [none]]]; 

RS232C.SetParameter [vars.channel, [stopBits [1]]]; 

RS232C.SetParameter [vars.channel, [latchBitClear [clearMask]]]; 
RS232C.SetParameter [vars.channel, [dataTerminalReady [TRUE]]]; 
RS232C.SetParameter[vars.channel, [requestToSend [TRUE]]]; 

RS2.32C .SetParameter[vars .channel, 

[flowControl [[type: xOnXOff, 

xOn: 17, -- DC1 (^q) 

xOff: 19]]]]; — DC3 (ts) 

END; -- of ReadyRS232C 


GetTransmissionAndConvert: PROCEDURE [vars: Variables, 

parms: K4.IconParms] = 


BEGIN 
byteArray: 
1ogAttrs: 


logFile: 

1ogStream: 
f o'l derName: 
dots: 

bytesLogged: 
bytesReceived; 
transferStatus 


PACKED ARRAY [0..bufferSize) OF Environment.Byte; 

ARRAY[0 . . 2) OF NSFi 1 e . Attribute «- [ 

[name [NSString.StringFromMesaString["K4TEXT.L0G"L]]], 
[type [2]]]; 

NSFile.Handle; 

NSFileStream.Handle; 

NSString.String; 

CARDINAL; -- to count dots announcing reception 

LONG CARDINAL; 

CARDINAL; 

: RS232C.TransferStatus; 


Process.SetPriority [Process.priorityNormal]; 
vars.data [header: Envi ronment. nul 1B1 ock, 

body: [blockPointer: @byteArray, 
startlndex: 0, 

stopIndexPlusOne; bufferSize], 
trailer; Environment.nullBlock]; 


DO -- run while window is open 
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dots <- 0; 
bytesLogged <- 0; 

Msg ["Waiting for transmission from Kurzweil 4000"L, TRUE]; 
[bytesReceived, transferStatus] <- GetBiock[vars] ; -- request 1st block 

IF vars.windowClosing THEN RETURN; 

Msg ["Receiving"L, TRUE]; -- announce initial reception 
logFile <-■ NSFile.Create [directory: NSFile.nullHandle, 

attributes: DESCRIPTOR[1ogflttrs]]; 
logStream <- NSFileStream.Create [logFile, FALSE]; 


DO 

IF vars.windowClosing THEN 
BEGIN 

Stream,Delete [logStream]; 

NSFile.Close [logFile]; 

RETURN; 

END; 

IF transferStatus # success THEN EXIT; 

IF bytesReceived = 0 THEN LOOP; 

vars . data. body . stopIndexPl usOne «- bytesReceived; 
bytesLogged «- bytesLogged + bytesReceived; 
dots ¥ IF dots > 50 THEN 0 ELSE dots + 1; 

Msg ["."L, (dots = 0)]; -- continue announcing block reception 

Stream.PutBlock [logStream, vars.data.body]; 

IF byteArray[bytesReceived - 1] = 200B THEN EXIT; 

[bytesReceived. transferStatus] «- GetBlock[vars]; 

ENDLOOP; 

IF bytesLogged < 5 THEN -- don't bother saving 4 bytes or less.,. 
BEGIN 

Msg [" Less than 5 bytes received. Ignored. "L, FALSE]; 

Stream.Delete [logStream]; 

NSFile.Close [logFile]; 

END 

ELSE 

BEGIN 

bytesLogged «- bytesLogged - 1; -- to drop the 200B added by K4000 
MsgDecimal [bytesLogged]; 

Msg [" bytes received."L, FALSE]; 

Stream.SendNow [logStream]; 

NSFileStream.SetLength [logStream, bytesLogged]; 

Stream.Delete [logStream]; 

folderName < XS.NSStringFromReader [Sparms.genProps.folderName, 

parms.heap]; 

PutFi1elnFolder [logFile, folderName]; 

NSString.FreeString [parms.heap, folderName]; 

Msg ["Spawning document creation."L, TRUE]; 

K4.ConvertToDocument [logFile, parms.docProps, 

parms.mapProps, parms.fonProps]; 

END; 

ENDLOOP; 

END; -- of GetTransmissionAndConvert 


GetBlock: PROC [vars: Variables] 

RETURNS [count: CARDINAL, status: RS232C.TransferStatus] = 

BEGIN 

completionHandle: RS232C.CompletionHand!e; 

vars. data. body. stopIndexPl usOne «- bufferSize; 
completionHandle <- RS232C . Get[vars . channel , @vars.data]; 

[count, status] <- RS232C . TransferWai t[vars . channel, completionHandle]; 
END; -- of GetBlock 


Reconvert: MenuData.MenuProc = 

BEGIN 

--*** use here selection interpretation in K4ToVPUtility 
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OPEN Selection; 

-- User has selected a 
-- and wants to make a 
f i leSel ect i on : Value «- 
tyfieSelection: Value <- 
typeAscii: NSFile.Type 


log stream in document folder 
new document from it. 

Convert [Target.file]; 

Convert [Target.fileType]; 

= 2 ; 


IF fileSelection.value = nullValue.value 
OR typeSelection.value = nullValue.value 
OR typeSelection.valuet # typeAscii THEM 
BEGIN 

Msg ["Reconverting: there is no selection to convert."L, 

TRUE]; 

END 

ELSE 

BEGIN 

refLoc: LONG POINTER TO NSFi le . Reference «- 

LOOPHOLE[fileSelection.value]; 
logFile: NSF i 1 e . Hand! e if NSFi 1 e .OpenByRef erence [refLoct]; 

-- file closed by conversion job 
Msg ["Spawning document creation."L, TRUE]; 

K4.ConvertToDocument [logFile, parms.docProps, parms.mapProps, parms.fonProps]; 
END; 

END; -- of Reconvert 


END. -- of K4WindowImpl 
LOG: 

Z3-Jan-87 16:42:05 created from DestTextWindowlmpl and K43Windowlmpl. 

4-Feb-87 11:47:24 moved pSheet items into body window, removed Options command. 

6-Feb-87 10:13:34 fixed storage leak (folderName/outputName not deallocated). 

6-Feb-87 17:58:04 implemented ReceiveScannerData as background job. 

13- Feb-87 10:56:09 redid entire RS232C interaction to prevent hanging in RS232C.Suspend. 

16-Feb-87 14:06:07 added warning sheet to run Editor if idle. 

18-Feb-87 15:47:10 added inspection of header to determine output type. 

26- Feb-87 17:22:49 implemented Interval Timer facility because text files from K4000 do not always have 
etx at the end, and we need to time out after a while, 

3- Mar-87 10:20:32 incorporated call to ConvertToCanvas, request to run VP Free-hand Drawing, etc... 

4- Mar-87 15:58:47 made PutFilelnFolder a public proc. 

10- Mar-87 14:24:23 adapted to linked property sheet, removed panel window in preparation of installing 
history window. 

11- Mar-87 14:05:31 turned into a message window. 

12- Mar-87 10:58:39 fixed messages/transmission coordination. 

16-Mar-87 10:12:10 added signature. 

18- Mar-87 14:38:46 cleared channel mask bits after deleting. 

19- Mar-87 10:12:40 mapProps not initialized in SpinOffDocument. 

23- Mar-87 15:21:14 added Reconvert command. 

24- Mar-87 13:30:21 ordering folder by creation date. 

2-Apr-87 10:43:20 saving/naming of logFile moved to K4CanvasImpl or K4DocumentImpl. 

6- Apr-87 15:45:27 creation of ConvertParms moved from here to K4DocumentImpl and K4CanvasImpl. 

7- Apr-87 13:54:40 removed useless start code. 

7-Apr-87 14:28:32 moved back here saving of logFile; had problem with holding same handle in two 
processes. 

9-Apr-87 11:46:09 Looks like the logFile does not have all the data received; so now using 
block/PutBlock instead of string/PutString to save bytes received from channel. 

14- Apr-87 14:44:48 removed saveLog. 

15- Apr-87 15:07:44 remove flow control on RS232C channel, set timeout to 1000 millisecs. 

18-Apr-87 16:27:55 restored flow control (still no clues about lost bytes: tried slower baud rates, 
larger timeouts, 7 bits, high priority processes, flow control/no flow control, larger buffers, ••)■ 

20- Apr-87 14:48:27 truncated the log stream by one byte because it seems that we always get one extra 
byte (200B) at the end, perhaps generated by the Suspend[channel]. 

20-Apr-87 14:49:40 picked up channel speed from option sheet. 

20-Apr-87 18:09:55 adjusted length of silence to channel speed. 

24-Apr-87 16:43:38 dropped canvas and ArtScan processing. 

27- Apr-87 10:08:52 "Reconvert" becomes "Make Document". 

27-Apr-87 13:25:32 transmission folder name. 

14- Sep-88 9:59:55 discovered that in VP2.0, we no longer get the last block; perhaps something with 
the 5 seconds wait in lower priority process; also discovered with DLM that the last byte of last 
transmission, 80X, is sent by Kurzweil, not added by Suspend or some such; thus, the code to wait a 
while to see if transmission is ended is replaced by testing 80X. 

15- Sep-88 9:13:53 cleared latch bits before deleting channel: I noticed that the DEST claims that the 
port is not ready after Kurzweil application has been used; perhaps clearing the latch bits will help. 
/ 


K4WindowImpl.mesa 


16-Sep-88 10:01:53 PDT 


6 



/» 


— l8octtUserImplA.mesa 

— 17-Apr-89 16:19:56 

— Copyright (c) 1989 by Xerox Corporation. All rights reserved. 

DIRECTORY 

OthelloDefs USING [ 

AbortlngCommand, CloseFetch, CommandProcessor, Confirm, GetName, 

IndexTooLarge, LeaderPage, leaderPages, lpVerslon, MyNamels, NewLlne, 

PackedTimeFromStrlng, Question, ReadNumber, ReglsterCommandProc. 

SatCommandStrlng, WrlteChar, WrlteFIxedWIdthNumber, WriteLlne, 

WrlteLongNumber, WrlteOctal, WrlteString, Yes], 

OthelloOps USING [ 

BedSwItches, BootFUeType, DecodeSwItches, DeleteTempFIles, GetDrlveSIze, 

GetNextSubVolume, GetPhysIcalVolumeBootFile, GetSwItches, GetVolumeBootFIle, 
nullSubVolume, SetDebugger, SetDebuggerSuccess, SetExpIratlonDate, 

SetExpIratlonDateSuccess, SetGetSwItchesSuccess, SetPhysIcalVolumeBootFile, 

SetSwItches, SubVolume, VqldPhysIcalVolumeBootFIle, VoldVolumeBootFile], 

OthelloToolDefs USING [CloseVolume], 

SpeclalVolume USING [OpenVolume], 

TemporaryBootlng USING [BootButton], 

Volume USING [ 

Erase, GetAttrlbutes, GetLabelStrlng, GetType, ID, 

NeedsScavenglng, NotOnllne, nullID, Open, systemID, Type], 

VolumelnltlmplA: PROGRAM 
IMPORTS 

File, Heap, Inline, OthelloDefs. OthelloOps, OthelloToolDefs, PhysIcalVolume, Process, Runtime, 
Scavenger, Space, SpeclalVolume, System, String, TamporaryBootlng, Volume, 

VolumeVerslon 
EXPORTS OthelloDefs 
SHARES File * 

BEGIN OPEN OthelloOps, OthelloDefs; 

Quit: PROC ■ {TemporaryBootlng.BootButtonQ}; 

SetPvBoot: PROC » 

BEGIN 

IvID: Volume,ID 4- GetLvIDFromUser[] . lvID; 

SpeclalVolume.OpenVolume[lvID, read]; 

FOR t: BootFUeType IN [softMIcrocode. .pilot] DO 

IF GetVolumeBootFile[lvlD, t].flle # FIle.nuUFIIe THEN { 
file: File.File; 
flrstPage: FIle.PageNumber; 

[file, flrstPage] <■ GetVolumeBootF11e[lvID, t]; 

SetPhys1calVolumeBootF11e[f11e, t, flrstPage]}; 

ENDLOOP; 

Ot.helloToolDefs .CloseVolume[l vIO]; 

END; 

GetUserlvID: PROC [] RETURNS [IvID: Volume.ID] - 
BEGIN 
DO 

ptmpID: PhysIcalVolume. ID <• PhysIcalVolume .null ID; 

Inputstring; LONG STRING *• ''User"; 
matches: CARDINAL *• 0; 

DO 

drlveTemp: PhysicalVolume.Handle; 

ItmpID: Volume.ID «■ Volume .null ID; 

IF (ptmpID 4- PhysIcalVolume.GetNext[ptmpID]) a PhysIcalVolume.nul1ID THEN EXIT; 
drlveTemp *• PhysIcalVolume.GetAttr1butes[ptmpID] . Instance; 

DO 

s: STRING ■ [maxNameLength]; 

IF (ItmpID *■ PhysIcalVolume.GetNextLog1calVolume[ptmpID, ItmpID]) 

- Volume.nullID THEN EXIT; 

GetLog1calVolumeName[ltmpID, s ! Volume.NotOnlIne a > LOOP]; 

IF FunnyEqual[dr1veTemp, s, Inputstring] THEN { 
matches «■ matches + 1; IvID 4- ItmpID; pvID 4* ptmpID; drive 4- drlveTemp}; 

ENDLOOP; 

ENDLOOP; 

SELECT matches FROM 

0 »> Wr1teStr1ng["Not found\r"L]; 

1 -> RETURN: 

ENDCASE *> Wr1teL1ne["Amb1gous; please specify Dev1ce:Log1calName"L]; 

ENDLOOP; 

END; 


Getl.oglcalVolumeName: PROC [vId: Volume.ID, s; STRING] - { 

Solength <- 0; 

Volume.GetLabelStr1ng[vld, s ! Volume.NeedsScavenglng *> GOTO bad]; 
EXITS bad -> £ 

IDRep: TYPE = RECORD [p; ARRAY [0..3) OF CARDINAL, n: LONG CARDINAL]; 
Str1ng.AppsndStr1ng[s, ’ , NeedsScaveng1ng"L]; 

String.AppendLongNumber[s, LOOPHOLE[v1d, IDRep].n, 8]}}: 


FunnyEqual: PROC [h: PhysIcalVolume.Handle, name: STRING, userName: LONG STRING] 
RI:TURNS[BOOLEAN] => { 

SameChar; PROC [a, b: CHARACTER] 

RETURNS [BOOLEAN] - £ 

IF a-b THEN RETURN[TRUE] 

ELSE IF a IN ['a..’z] AND b IN [*A..'Z] AND (a-’a+’A) a b THEN RETURN[TRUE] 
ELSE IF a IN [’A..’Z] AND b IN fa.-’z] AND (a-'A+’a)«b THEN RETURN[TRUE] 
ELSE RETURN[FALSE]}; 
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IF String.Equlvalent[name, userName] THEN RETURN[TRUE]; 

FOR 1: CARDINAL IN [0..drlveName.length) DO 

IF ~SameChar[dr1veName[1], userNaiii9[1]] THEN RETURN[FALSE] ENDLOOP; 

IF drlveName.length+name.length+1 0 userName.length THEN RETURN[FALSE]; 

IF userName[dr1veName.length] # *: THEN RETURN[FALSE]; 

FOR 1: CARDINAL IN [0..name.length) DO 

IF ~SameChar[name[1], userName[dr1veName.length+l+l]] THEN RETURN[FALSE] 
ENDLOOP; 

RETURN[TRUE]}; 


END 
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Add Initialization of U-regs uGFI (for MDS relief) and uldleCount* 

Removed definition of FPTEnabled and stuck it in DualBank.dfn & Sing!eBank.dfn with values 2 and 0, to indicate 
point is In uCode 

Remove InitOaybreak from emulator and make into initialization routine 

Make uFactoruCode value conditional (set to FPTEnabled Iff two control store banks) 

merged EIS InitDaybreak,mc with the existing InitOaybreak.me to build a MesaDove with floating point microcode 
Initialize uFactoruCode and uTimesWplDisp 
Inserted ClrLOCK to test slow mode. 

Corrected offsetMaintPanel and offsetMesaProc 
Op ie redesign conversion 
removed ulF 

changed value of uMaintPanel for Opie 19 
added uMaintPanel init 
initialized uPPMask to E000} 


{ 


Copyright (C) 1984, 1985, 1986 by Xerox Corporation, 


All rights reserved.} 


StartAddress[BootT rap]; 


Set[TGCount, 40]; 
Setj'TICount, 41]; 
Set('T2Count, 42]; 
Set[T012Control, 43]; 
SetfTQDisable, 48]; 
SetfTOEnable, 4C]; 
Set[T12Di sab 1 e , 50]; 
Set[T12Enable, 54]; 


Set('T0Mode2, 34]; 

SetfTIModeO, 50]; 

Setj'T!Mode2, 74]; 

Set(T2Mode2, 0B4]; 

Set[T0InitialLSB, 035]; 

Setj'TOInl tialMSB, OC]; {0C35 hex = 3125 decimal counts - 50 milliseconds} 

SetJ'offsetMalntPanel, Lshift[8, 1]]; 

Set[offsetMesaProc, Lshift[11,1]]; 

{Get here when the boot button is pushed, or somebody yanks on INIT/.} 


BootTrap: {From trap branch in Refill.me} 

ClrlntErr, ClrLOCK, CANCELBR[$,OF] {must be cl}, cl, at[0 |; 

ClrMPIntlOP, c2; 

G *• 0, uPCCross «- 0, c3; 

{set up timer counters} 

rhRx t- TODisable, cl; 

T <- TOIni tial LSB , c2 : 

TT *■ T0Mode2, c3 ; 

10 «■ [rhRx, 0], cl; 

MDR *■ 0, {disable counter 0} c2; 

rhRx <- T12Disable, c3; 

10 *■ [rhRx . 0] , cl; 

MOR «- 0, {disable counters 1 and 2} c2; 

rhRx «- TOt2Control, c3: 

10 <- [rhRx, 0], cl; 

MDR «- TT, {set counter 0 mode}, c2; 

TT <- T2Mode2 , c3 ; 

10 *■ [rhRx, 0], cl: 

MDR *- TT, {set counter 2 mode}, c2; 

rhRx «- TOCount, c3 ; 

10 *■ [rhRx, 0], cl; 

MDR «■ T, [set counter 0 initial count LSB}, c2; 

T *• TOIni tialMSB , c3; 

10 *■ [rhRx, 0], cl; 

MDR «■ T, {set counter 0 initial count MSB}, c2: 

rhRx «■ T2Count, c3 ; 

10 <■ [rhRx, 0], cl; 

MDR «- 0, {set counter 2 initial count LSB}, c2; 

TT <- TIModeO , c3; 

10 «• [rhRx, 0], cl; 

MDR «■ 0, {set counter 2 initial count MSB}, c2; 

rhRx «- TOEnable, c3; 

10 «■ [rhRx , 0] , cl; 

MDR *- 0, {enable counter 0} c2; 

rhRx «■ T12Enable, c3; 

10 *■ [ rhRx , 0] , cl; 

MDR «■ 0, {enable counters 1 and 2} c2; 

rhRx *- T012Control , c3; 

10 «- [rhRx, 0], cl; 

MDR «■ TT, {set counter 1 setup mode}, c2; 

TT «■ TlMode2 , c3 ; 

10 ^ [rhRx, 0], cl; 

MDR <- TT. (set counter l mode}. c2; 
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rhRx <- TICount, 


c3; 


/ 


10 <- [rhRx , 0], cl; 

MDR *■ 0, {set counter 1 initial count LSB}, c2; 

T «- 1, c3; 

10 <- [rhRx, 0], cl; 

MDR <- 0, {set counter 1 initial count MSB}, UBrkByte *■ 0, c2; 
uWDC *■ T, ClrlE, {disable interrupts} c3; 

SetupConstants: 

{ TT «- uFactoruCodeVal , cl; 

uFactoruCode <- TT, c2; 

uTimesWplDisp <- 0, c3; 

*** uFactoruCode and uTimesWplDisp were removed since uFactoruCode clashes with uVirtPage and FPTEnabled performs the function done by 
uFactoruCode. uTimesWplDisp was removed since it is used only for emulating special Versatec opcodes ***} 


TT * RShiftl 0, SE <■ 1, cl; 

u8000 <- TT, c2 ; 

TT «■ LShiftl OFF. SE<-1, c3; 

TT «■ LShiftl TT, SE<-1, cl; 

TT «• TT LShiftl, SE<-1, c2; 

u7FF *■ TT. TT «- TT LShiftl, SE «- 1, c3: 

TT TT LShiftl, SE <- 1 , cl; 

ulFFF «- TT, TT «- TT LShiftl, SE <- 1, c2: 

u3FFF *■ TT, c3; 

TT «- OIF, cl; 

TT <- TT LRot8, c2; 

TT «■ TT or 0F8, c3; 

uPMask <- TT, {1FF8} cl; 

uPMask2 «■ TT, c2; 

rOlOO «■ OFF + 1. {0100} c3; 

TT OEO, cl; 

TT «- TT LRot8, {EOOO} c2; 

uPPMask ^ TT, c3; 

TT *■ 64, cl; 

TT TT LRot8, c2; 

UtbFlags «- TT, {6400} c3; 

Q «■ rhIORgn *■ 5, cl; 

rlORgn «• 20, c2; 

rIORgn *■ rlORgn LRot8, {IORgn real addr = 52000} c3; 

MAR [rhIORgn, rlORgn + offsetMaintPanel ], cl; 

uIORgnHigh «- Q, CANCELBR[$ ,0] , c2: 

TT «- MD, c3; 

TT «■ TT LRotl2, cl; 

TT *■ RShiftl TT, SE + 0. c2; 

uMaintPanel *■ TT, c3; 

MAR <- [rhIORgn, rlORgn + offsetMesaProcJ, cl; 

MAPA «■ 4, CANCELBR[$,0] , {VM map real addr = 40000H} c2; 

TT «• MD, c3 ; 

TT «- TT LRot 12 , cl; 

TT <- RShiftl TT, SE «• 0, c2; 

uMesaProc <- TT, c3: 

SetLIpEniulatorRegs; 

rhT <- xtFCO , cl; 

UvMDS «■ T «- 0, c2; 

rhMDS «- 0, TOS «- 0, c3; 

uGFI «■ 0, cl; 

uldleCountLow *■ 0, c2; 

uldleCountHigh *■ 0, c3; 

UvG «- rlnt «- 0, cl; 

uXTS «• stackP <- T, c2; 

uWP «- T, PC «- T + 0 + l{use carry}, SetMPIntlOP, c3; 

TT «- OFF LShiftl. SE «■ 1, {IFF} cl; 

T <- TT + 3{@SD[ sBoot]} , c2 ; 

uDestLo «- T, L «- 0, ClrMPlntlOP, c3; 


{initialization done, now loop until IOP halts the CP} 

{emulator will resume from this address} 

Linkage: 

GOTOABS[addrLinkage], tl(c'), at[addrLinkage]; 
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-- Copyright (C) 1986 by Xerox Corporation. All rights reserved. 
-- OthelloToolDefs.mesa 

-- Created by NFS 4-Jun-86 10:49:17 

DIRECTORY 

TTY USING [Handle], 

Volume USING [ID]; 

OthelloToolDefs.DEFINITIONS = { 

tty: TTY.Handle: 

Run: PROCEDURE; -- Instead of PI1otCllent.Run 
CloseVolume: PROCEDURE[volume: Volume.ID]; 

}• 
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-- Copyright (C) 1986 by Xerox Corporation. All rights reserved. 

-- OthelloToolImpl.mesa 

-- Created by NFS 4-Jun-86 10:26:30 

DIRECTORY 

Exec USING [AddCommand, ExecProc, RemoveCommand], 

Othel1oToolDefs USING [Run], 

Process USING [Abort], 

Runtime USING [GetBcdTIme], 

String USING [AppendString], 

Time USING [Append, Unpack], 

Tool USING [Create, Destroy, MakeSWsProc, MakeTTYSW, UnusedlogName], 

ToolWindow USING [Activate, TransitionProcType], 

TTY USING [Handle], 

TTYSW USING [GetTTYHandle] , 

Version USING [Append], 

Volume USING [Close, ID, systemlD], 

Window USING [Handle]; 

OthelloToolImpl: PROGRAM 
IMPORTS 

Exec, Runtime, String, OthelloToolDefs, Process, Time, 

Tool, ToolWindow, TTYSW, Version, Volume 
EXPORTS OthelloToolDefs = { 

tty: PUBLIC TTY.Handle; 

toolWindow: Window.Handle; 

Commandlnterpreter: PROCESS; 

In It: PROCEDURE = { 

name: LONG STRING <- [75]; 
name.length <- 0; 

String.AppendString[name, "OthelloTool ”L]; 

Version.Append[name]; 

String.AppendString[name , " of "L]; 

Time . Append[name .Time .Urtpack[Runt ime .GetBcdTime[]]] ; 
toolWindow <■ Tool ,Create[ 

name: name, makeSWsProc: MakeTTYSW, clientTransition: Stop, 
cmSectlon: "OthelloTool"L, tinyNamel: "Othello"L, t1nyName2: "Tool"L]; 

Exec.AddCommand[name: "OthelloTool.~"L, proc: Activate, unload: DestroyTool] : 

}: 

Stop: ToolWindow.TransitionProcType = [ 

IF new = Inactive THEN { 

Process.Abort[CommandInterpreter]; 

JOIN Commandlnterpreter;}; 

}; 

Activate: Exec.ExecProc = {ToolWindow.Act1vate[toolWindow];}; 

DestroyTool: Exec.ExecProc = { 

Exec.RemoveCommand[h, "Othel1oTool.~"L]; 

Tool.Destroy[toolWindow]; 

}; 


MakeTTYSW: Tool.MakeSWsProc = { 
logName: LONG STRING «■ [20]; 
ttySW: Window.Handle; 

1 ogName. length «• 0; 

Tool.UnusedLogName[unused:logName, root: "OthelloTool.log"L]; 
ttySW *■ Tool .MakeTTYSW[w1 ndow :w1ndow, name : 1 ogName] ; 
tty «• TTYSW.GetTTYHandle[ttySW]; 

Commandlnterpreter *- FORK Othel loToolDef s .Run[] ; 

}: 


CloseVolume: PUBLIC PROCEDUR£[volume: Volume.ID] = { 

IF volume # Volume.systemlD THEN Volume.Close[volume];}; 

I n 11 [ ]; 
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File: OthelloDefs.mesa - last edit: 

— Higgle.PA 12-Jan-87 16:06:45 

Othel loDefs.mesa (last edited by: RXJ 19-Apr-83 10:54:58) 

-- Copyright (C) 1987 by Xerox Corporation. All rights reserved. 

DIRECTORY 

Device USING [Type], 

Environment USING [bytesPerWord, wordsPerPage], 

PhysicalVolume USING [Handle, ID], 

System USING [GreenwichMeanTime], 

Volume USING [ID, Type]; 

OthelloDefs: DEFINITIONS = 

BEGIN 

CommandProcessor: TYPE = RECORD [ 

proc: PROC [Index: CARDINAL], next: LONG POINTER TO CommandProcessor +• NULL]; 
MyNamelS: SIGNAL [myNamels: LONG STRING, myHelpIs: LONG STRING]; 

-- resuming executes command 

AbortlngCommand: ERROR [reason: LONG STRING, reasonOne: LONG STRING NIL]; 
IndexTooLarge: ERROR; 

Question: SIGNAL; 

RoglsterCommandProc: PROC [commandProc: LONG POINTER TO CommandProcessor]; 

ConflrmType: TYPE = {once, twice, thrice}; 

EehoNoEcho: TYPE = {echo, stars}; 

-- Utility Io 

Confirm: PROC [how: ConflrmType <- once]; 

DebugAsk: PROC: 

GetName: PROC [ 

prompt: LONG STRING, dest: LONG POINTER TO LONG STRING, 
how: EehoNoEcho «- echo, slgnalQuestlon: BOOLEAN *■ FALSE]; 

ReadNumber: PROC [ 

prompt: LONG STRING, min, max: LONG CARDINAL, 

default: LONG CARDINAL «■ LAST[LONG CARDINAL]] 

RETURNS [ans: LONG CARDINAL]; 

ReadShortNumber: PROC [ 

prompt: LONG STRING, min, max, default: LONG CARDINAL] 

RETURNS [CARDINAL]; 

WriteFixedWidthNumber: PROC [ 

x: LONG CARDINAL, count: CARDINAL, base: CARDINAL «■ 10]; 

WriteLongNumber: PROC [num: LONG CARDINAL]; 

WrlteOctal: PROC [CARDINAL]; 

Yes: PROC [LONG STRING] RETURNS [BOOLEAN]; 

Basic 10 

Cursor: TYPE = {pointer, ftp}; 

SetCursor: PROC [Cursor]; 

FIipCursor: PROC; 

SetCommandStrlng: PROC [LONG STRING]: -- string will be freed to Storage. 

B1InkDisplay: PROC; 

CheckUserAbort: PROC: -- clients should prepare UNWIND In case of abort. 

NewLine: PROC; 

ReadChar: PROC RETURNS [CHARACTER]; 

WrlteChar; PROC [CHARACTER]; 

WriteLine: PROC [LONG STRING]; 

WriteStrlng: PROC [LONG STRING]; 

PackedTimeFromString; PROC [s: LONG STRING, justDate: BOOLEAN] 

RETURNS [System.GreenwichMeanTime]: 
string format must be: 

IF justDate=FALSE THEN bDD-MMM-YYbbHH:MM:SSbbZZTb 
IF justDate=TRUE THEN bDD-MMM-YYb 
return System.gmtEpoch for bogus time 

Exported by VolumelnitlmplA 
GetLvIDFromUser: PROC [ 

prompt: LONG STRING «- NIL, cal ledFromSetDebuggerPtrs: BOOLEAN *■ FALSE] 

RETURNS [ 

pvID: PhysicalVolume.ID, lvID: Volume.ID, 
drive: PhysicalVolume.Handle]; 

GetLvTypefromUser: PROC [prompt: LONG STRING, defaultType: Volume.Type] 

RETURNS [t: Volume.Type]; 

GetDriveFromUser: PROC RETURNS [h: PhysicalVolume.Handle]: 

GetDriveNumber: PROC [h: PhysicalVolume.Handle] RETURNS [CARDINAL]; 

GetDriveType: PROC [h: Physical Volume.Hand!e] RETURNS [Device.Type]; 

-- Get bits interface for Initial ucode fetch 
FetchlnltialMIcrocode: PROC [ 

Instal1Proc: PROC [getPage: PROC RETURNS [LONG POINTER]]]; 

-- Clean up any outstanding ftp/stp/?? like connections 
CloseFetch: PROC; 

leader pages on boot files 
leaderPages: CARDINAL = 1; 

lpVersion: CARDINAL = 04193; 

IpNoteOffset: PRIVATE CARDINAL = 2; 

IpNoteLength: CARDINAL - 

(Environment.wordsPerPage-IpNoteOffset)*Environment.bytesPerWord; 
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LeaderPage: TYPE = MACHINE DEPENDENT RECORD [ 
version(O): CARDINAL <- IpVerslon, 
longth(l): CARDINAL, -- count of characters in note 
note(IpNoteOffset): PACKED ARRAY [0..1pNoteLength) OF CHARACTER]; 

-- test for special commands enabled 

Wizard: PROC RETURNS [BOOLEAN]; 

-- Crock to make >0[foo]baz work 

AlternateGetCMFile: PROC [LONG STRING]; 

-- aids for othello varients implementing canned scripts (prometheus) 

GetCannedScript: PROC; 

SuppressOutput; PROC RETURNS [BOOLEAN]; 

TherelsAnError: PROC; 

END. . . . 
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-- File: OthelloFetch.mesa - last edit: 

Higgle.PA 12-Jan-87 16:10:06 

-- OthelloFetch.mesa 
— RXJ 22-Feb-84 16:46:26 

Copyright (C) 1987 by Xerox Corporation. All rights reserved. 

DIRECTORY 

File USING [File], 

Stream USING [Handle]: 

Othel!oFetch: DEFINITIONS = 

BEGIN 

Destination: TYPE = RECORD [ 

SELECT type: + FROM 

pilotFileSystemWrite => [localFile: File.File], 
string => [stringProc: PROC [LONG STRING]], 

rawWrite => [linkProc: PROC [getPage: PROC RETURNS [LONG POINTER]]]. 
ENDCASE]; 

Object: TYPE = RECORD [ 
next: Handle «■ NIL, 

Retrieve: PROC [fileName: LONG STRING, destination: Destination], 
Dolndlrect: PROC [cmFIle: LONG STRING] RETURNS [mine: BOOLEAN], 

List: PROC [pattern: LONG STRING], 

Close: PROC]; 

Handle: TYPE = LONG POINTER TO Object: 

Register: PROC [h: Handle]; 

Select: PROC [h: Handle]; -- makes h current; closes previous 
SetLeaderPage: PUBLIC PROCEDURE [file: File.File, note: LONG STRING]; 
StartFeedback: SIGNAL; 

GrabBitsFromStream: PROC [rs: Stream.Handle, rsSIzePages: LONG CARDINAL, 
destination: Destination, note: LONG STRING <- NIL]; 

userName, userPassword: LONG STRING; 

directory: LONG STRING; 

END. 
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-- Copyright (C) 1983 by Xerox Corporation. All rights reserved. 

EtherBooter,mesa, RXJ , ll-Jul-83 16:35:04 
“■ NFS 10-Jun-86 10:42:13 adapted for OthelloTool 


DIRECTORY 

Boot USING [EthernetBootFileNumber, EthernetRequest], 

Heap USING [systemZone], 

HostNumbers USING [HostNumber], 

WSConstants USING [bootServerSocket], 

OthelloDefs USING [ 

AbortingCommand, CommandProcessor, Confirm, GetName, 

IndexTooLarge, MyNamels, RegisterCommandProc], 

SpeciaiBooting USING [BootFromEthernet], 

String USING [CopyToNewString], 

System USING [ 

broadcastHostNumber, defaultSwitches, 

NetworkAddress, nulINetworkNumber, Switches], 

Unformat USING [Error, HostNumber]; 

EtherBooter: PROGRAM 

IMPORTS Heap, OthelloDefs, SpeciaiBooting, String, Unformat = 

BEGIN 

HostNumber: TYPE = HostNumbers.HostNumber; 

bootFlleNumber; LONG STRING; 

EtherBoot: PROCEDURE = 

BEGIN 

request: Boot.EthernetRequest; 

switches: System. Switches <- System.defaul tSwitches; 

OthelloDefs.GetName["Ether Boot from boot file number: "L, GbootFileNumber]; 
GetAddress[@request.bfn, bootFlleNumber ! 

Unformat.Error => OthelloDefs.AbortingCommand["Can't parse that one (No CHV'Lll; 
OthelloDefs.Confirm[]; 
request .address <- [ 
net: System.nullNetworkNumber. 
host: System.broadcastHostNumber, 
socket: NSConstants.bootServerSocket]; 

SpeciaiBooting.BootFromEthernet[ 

ethernetRequest: request, devIceOrdlnal: 0 , switches: switches]; 

END; 

GetAddress: PROCEDURE [host: POINTER TO Boot.EthernetBootF11eNumber. s: LONG STRING] = 
BEGIN 

host* 4- [LOOPHOLE [Unformat. HostNumber[s , octal]]]; 

END; 

Commands: PROCEDURE [Index: CARDINAL] = 

BEGIN 

SELECT index FROM 
0 => 

BEGIN 

OthelloDefs,MyNameIs[ 
myNamels: "Ether Boot"L, 

myHelpIs: "Load another program over the Ethernef’L]; 

EtherBoot[]; 

END; 

ENOCASE => Othel!oQefs,IndexTooLarge; 

END; 

commandProcessor: Othel loDefs .CommandProcessor <- [Commands]: 

bootFlleNumber <- String.CopyToNewString["25200001000'\ Heap.systemZone]; -- Setup Default 

OthelloDefs.RegisterCommandProc[@commandProcessor]; 

END. 
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-- File: OthelloFetchlrnpl.mesa - last edit: 

-- NFS 3-Jul-86 15:02:29 

-- bjd 22-Jun-85 12:17:33 

-- rkj 26-Feb-84 15:24:23 

-- Copyright (C) 1986 by Xerox Corporation. All rights reserved. 

DIRECTORY 
Env1ronment, 

File USING [ 

Create, Delete, File, MakePermanent, null File, PageNumber, SetSize, Unknown], 
FileTypes USING [tUntypedFile], 

Heap USING [systemZone], 

MFl'le, 

MStream, 

NSName, 

NSString, 

OthelloDefs USING [ 

AbortlngCommand, CommandProcessor, Confirm, FlipCursor, 

GetLvIDFromUser, GetName, 

IndexTooLarge, LeaderPage, leaderPages, lpNoteLength, lpVersion, 

MyNaniels, Question, RegisterCommandProc, WriteLine, WrlteString, Yes], 
OthelloFetch USING [Destination, Handle, Object, StartFeedback], 

OthelloOps USING [ 

BootFileType, GetVolumeBootFile, MakeBootable, MakeUnbootable, 
SetPhysicalVolumeBootFile, SetVolumeBootFile], 

OthelloToolDefs USING [CloseVolume], 

Process , 

Profile , 

Space, 

Special File USING [MakeTemporary], 

Stream, 

String , 

TemporaryBooting USING [InvalidParameters] , 

Time, 

Volume USING [ID, InsuffIcientSpace, Open, systemID]; 

OthelloFetchlrnpl: MONITOR 
IMPORTS 

File, Heap, MFile, MStream, NSString, OthelloDefs, OthelloFetch, 

Othelloops, OthelloToolDefs. 

Process, Profile, Space, SpecialFile, Stream, String, 

TemporaryBooting, Time, Volume 
EXPORTS OthelloDefs, OthelloFetch = 

BEGIN 

Object: TYPE = OthelloFetch.Object: 

Handle: TYPE = OthelloFetch.Handle: 

1 1st: Handle *■ NIL; 

current: Handle «- NIL; 

cmFile: LONG STRING «■ NIL; 
fileName: LONG STRING *■ NIL; 

z: UNCOUNTED ZONE = Heap.systemZone; 

S: PROC [s: LONG STRING] RETURNS [NSString.String] = INLINE { 

RETURN[NSString.StringFromMe$aString[s]]}; 

-- Fetcher registration 

Register; PUBLIC PROC [h: Handle] = 

BEGIN 

h . next *■ list; 

1 ist*- h; 

END; 

Select: PUBLIC PROC [h: Handle] = 

BEGIN 

IF current # NIL THEN current,Close[]; 
current*- h; 

END; 


String/Credentials Commands 


ClearinghouseCmd: PROC = { 

domain, organization: Prof ile .String *- NIL; 

CopyDomain: PROCEDURE[s: LONG STRING] = { 
domain «■ String .CopyToNewStringfs , z];}; 
CopyOrganization: PROCEDURE[s: LONG STRING] = { 
organization *- String .CopyToNewStrl ng[s . z];}; 
(ENABLE UNWIND => { 

IF domain # NIL THEN z.FREE[@domain] ; 

IF organization # NIL THEN z,FREE[@organization];}; 
OthelloOefs,MyNameIs[ 

myNamels: "Clearinghouse"L, 
myHelpIs: "Set defaults for Clearinghouse"L]; 
Profile.GetDefaultDomain[CopyDomain]; 

Prof1le.GetDefaultOrganization[CopyOrganization]; 
OthelloDefs,GetName["Domain: "L, ©domain]; 

OthelloDefs.GetName["Organization: "L, ©organization]; 
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Prof 1le.SetDefaultDomain[domain]; 

Profile.SetDefaultOrganizatlon[organizatlon]; 

}; 

z.FR£E[@doma1n]; z.FREE[©organIzatlon]; 


LoginCmd: PROG = { 

userName, userPassword: Prof lie.String «- NIL; 
CopyNameAndPassword: PROCEDURE[name, password: LONG STRING] - { 
userName <- String .CopyToNewStr1ng[name , z]; 
userPassword «• String .CopyToNewStr1ng[password , z];} ; 

(ENABLE UNWIND => { 

IF userName # NIL THEN z.FREE[@userName]; 

IF userPassword # NIL THEN z.FREE[@userPassword];}; 

OthelloDefs.MyNameI$[ 

myNamels; "Log1n"L, myHelpIs: "Set user name & password"L]; 
Profile.GetUser[CopyNameAndPassword, none]; 

OthelloDefs.GetName["User: "L, ©userName]; 

OthelloDefs.GetName["Password: "L, ©userPassword, stars]; 
Profile.SetUser[userName, userPassword]; 

}: 

z . FR£E[@userName]; z.FREE[©userPassword]; 


directory: PUBLIC LONG STRING «• NIL; 

Directory: PROC 3 { 

OthelloDefs.MyNameIs[ 
myNamels; "D1rectory"L, 
myHelpIs: "Set Default FTP directory"L]; 
OthelloDefs,GetName["D1rectory: "L, ©directory]}; 


-- Stimple Fetches 
FetchBoot: PROC = ( 


Fetch[pilot, "Boot 

file 

name: 

"L 

FetchGerm: PROC = ( 




Fetch[germ, "Germ 

file 

name: 

"L 

FetchPIlotMIcrocode: 

PROC 

-- { 


Fetch[ 



softMicrocode, 




"Pilot microcode 

file 

name: 

"L 

"Pilot Microcode 

Fetch"L. 


"Fetch and Tnstal 

1 Pi- 

lot Mi 

croc 

"db"L]}; 




FetchDiagnosticMicroc 

ode : 

PROC 

= c 


"Fetch Boot File"L. "Fetch Boot File"L, "boof'L, TRUE]}: 
"Germ Fetch"L, "Fetch Germ"L, ’'germ"L]}; 


Fetch[ 

hardMIcrocode, 

"Diagnostic microcode file name: "L, 
"Diagnostic Microcode Fetch"L, 

"Fetch and Install Diagnostic Microcode"L, 
"db"L]}; 


Fetch: PROC [ 

type: OthelloOps.BootFileType, prompt, name, helpMsg, extension: STRING, 

bootFIle: BOOLEAN «- FALSE] = { 

created: BOOLEAN; 

file: File.File; 

flrstPage: Fi1e,PageNumber; 

IvID: Volume.ID; 

local: BOOLEAN <- current = NIL: -- if no connection open, assume local file. 
OthelloDefs.MyNameIs[myNameIs: name, myHelpIs: helpMsg]; 

IvID OthelloDefs.GetLvIDFromUser[] .IvID; 

OthelloDefs,GetName[prompt, @flleName]; 

IF IvID = Volume.systemID AND bootFile THEN { 

— fetching boot file for system volume. 
oldFile: File.File; 

IF local THEN file «• GetLocalFilepvID, File.nullFile 
INoLocalFile => GOTO NoFetch] 

ELSE { 

file «- F11e.Create[lvID, 1, FileTypes . tUntypedFI 1 e] ; 
current.Retrieve[fileName, [pilotFileSystemWr1te[file]] 

IUNWIND => File.Delete[flie]; 

Volume.InsufficientSpace, Space.InsufficientSpace 3 > { 

OthelloDefs,WriteL1ne["InsuffIclent space for new boot file."L]; 

File.Delete[file]; 

GOTO NoFetch;}];}; 

OthelloOps.MakeUnbootable[file, type, flrstPage ! 

File.Unknown => CONTINUE; 

TemporaryBooting.InvalIdParameters => CONTINUE]; 

[oldFile, flrstPage] <- Othel 1 oOps .GetVolumeBootF i 1 e [ 1 vID, type]; 

OthelloOps.MakeUnbootable[oldFile, type, firstPage ! 

File.Unknown => CONTINUE; 

TemporaryBooting.InvalIdParameters = > { 

OthelloDefs.WriteLine["Warning, trouble making unbootab1e"L]; 
CONTINUE}]; 

Special File.MakeTemporary[oldFile]; 
created <- TRUE;} 

ELSE { -- not system volume 
Volume.Open[lvID]; 

[file. firstPage] «- Othel 1 oOps .GetVol umeBootFi le[ lv ID. type]; 

IF local THEN { 

newBootFile: File.File; 
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created <■ TRUE; 

newBootFile «- GetLocalFile[lvID, file INoLocalFile => GOTO NoFetch]; 
file «■ newBootFIle;} 

ELSE { 

IF (created * file = File.nullFIle) THEN 

file «• File,Create[lvID, 1, FileTypes.tUntypedFile] 

ELSE OthelloOps.MakeUnbootab1e[file, type, firstPage ! 

File.Unknown => CONTINUE; 

TemporaryBooting.InvalidParameters => { 

OthelloDefs.Wr1teLine["Warn1ng, trouble making unbootable"L] ; 
CONTINUE}]; 

current.Retr1eve[fileName, [pilotF1leSystemWrlte[f11e]] 

! UNWIND => { 

IF created THEN F11e.Delete[fi1e];Othel1oToolOefs.CloseVo!ume[1vID]}]; 

}: 

}; 

OthelloDefs.Wr1teString["Instal11ng. ..”L]; 

OthelloOps.SetVolume8ootFile[flie, type, Othel!oDefs.1eaderPages]; 

IF created THEN File.MakePermanent[flie]; 

OthelloOps,MakeBootable[file, type, OthelloDefs.leaderPages 
! TemporaryBooting.InvalIdParameters = > { 

OthelloDefs.Wr1teLine["Warn1ng, trouble making bootable"L]; CONTINUE}]; 
OthelloDefs.WriteL1ne["done"L]; 

IF type IN [hardMicrocode..germ] AND 

OthelloDefs.Yes["Sha11 I also use this for the Physical Volume? "L 
! UNWIND => OthelloToolDefs.C1oseVolume[lvID]] THEN 
OthelloOps.SetPhysicalVolumeBootFile[file, type, OthelloDefs.leaderPages]; 
OthelloToolDefs.CloseVolume[lvID]; 

EXITS NoFetch => NULL; 


NoLocalFile: ERROR = CODE; 

GetLocalFile: PROCEDURE [ 

1vID: Volume.ID, oldFIle: File.File] RETURNS [file: File.File] = { 

-- fileName already has name of local file. 
mStream: MStream.Handle; 
fllePages: LONG CARDINAL; 
note: LONG STRING; 

mStream «- MStream. ReadOnly[fi 1 eName , [] ! 

MStream.Error => { 

OthelloDefs.Wr1teL1ne["Unable to acquire local fi1e"L]; 

ERROR NoLocalFile;}]; 

IF oldFIle # File.nullFIle THEN File.Delete[oldFile]; 

fllePages *• (MStream.GetLength[mStream] + Environment.bytesPerPage -1) / 
Environment.bytesPerPage; 
file «• Flle.Create[ 

volume: IvID, InitlalSIze: fllePages +• OthelloDefs .leaderPages, 
type: FileTypes.tUntypedF1le ! 

Volume . Insuff IcientSpace = > OthelloDefs.Abort1ngCo(nmand[''Volume FulT'L]]; 
note «- MakeNote[MStream.GetFile[mStreamj]; 

GrabBItsFromStream[ 

mStream, fllePages, [pi 1otFi1eSystemWrite[fi1e]], note! 

OthelloFetch.StartFeedback => { 

OthelloDefs.WrlteString["Copying local file..."L]; 

RESUME}]; 

OthelloDefs,WriteLIne["done"L]; 

Stream.Delete[mStream]; 
z.FREE[@note]; 


bufPages; CARDINAL = 8; 

StartFeedback: PUBLIC SIGNAL = CODE; 

MakeNote: PROCEDURE[file: MFi1e.Handle] RETURNS[note: LONG STRING] = { 
time: LONG STRING <- [20]; 

note *■ z .NEW[StringBody[MFi le .maxNameLength]] ; 
note, length *■ 0 ; 

MFile.GetFullName[flie. note]; 

String.AppendStringAndGrow[@note, " ("L, z]; 

Time.Append[time, Time.Unpack[MFile.GetCreateDate[file]]]; 

String.AppendStringAndGrow[Onote, time, z]; 

String.AppendCharAndGrow[@note, '), z]; 


GrabBitsFromStream: PUBLIC PROC [ 

rs: Stream.Handle, rsSizePages: LONG CARDINAL, 

destination: Othel 1 oFetch.Destination, note: LONG STRING *- NIL] = { 

WITH destination SELECT FROM 
pilotFIleSystemWrite => { 
buffer: LONG POINTER *- NIL; 
base: File.PageNumber *■ 0; 
got: CARDINAL; 

F11 e. SetS lze[ local File, rsSizePages +- Othel loDefs . 1 eaderPages 
! Volume.InsufficIentSpace => OthelloDefs.AbortingCommand["Volume FulT'L]]: 
SetLeaderPage[localF11e, note]; 

SIGNAL StartFeedback; 

WHILE base < rsSizePages DO 

thisPages: CARDINAL = CARDINAL[MIN[rsSizePages-base. bufPages]]: 
size: CARDINAL = thisPages*Environment.bytesPerPage; 

start: CARDINAL <- 0; 

nProcesses *■ 0; 
buffer «- Space.Map[ 

window:[localF ile, base+OthelloDefs.leaderPages. thisPages], 
life: dead].pointer; 

DO 


OthelloFetchlmpl.mesa 


22-Jan-87 13:55:45 PST 


3 





[bytesTransferred: got] «• rs .GetBlock[[ 

blockPointer: buffer, startlndex: start, stoplndexPlusOne: size] ! 
Stream.EndOfStream => { 

got «■ 0; start <- start + nextlndex; CONTINUE); 

UNWIND => [] «• Space .Unmap[buffer]]; 

IF got = 0 THEN {[] *■ Space .Unmap[buffer]; RETURN); 

IF (start «- start + got) = size THEN EXIT; 

ENDLOOP; 

ForkUnmap[buffer]; 

OthelloDefs.FIipCursor[]; 
base *■ base + thisPages; 

ENDLOOP; 

buffer *- Space.ScratchMap[ 1] ; -- check for any leftover stuff 
[bytesTransferred: got] * rs.GetBlock[[ 
blockPoInter: buffer, startlndex: 0, 
stopIndexPlusOne: Environment.bytesPerPage] ! 

Stream. EndOfStream => {got «■ nextlndex; CONTINUE); 

UNWIND => [] *■ Space ,Unmap[buffer] ]; 

[] «■ Space .Unmap[buffer] ; 

IF got # 0 THEN OthelloDefs.AbortingCommand[ 

"File longer than advertised length”L]); 
string => { 

SIGNAL StartFeedback; 

DO 

stringOverhead: CARDINAL = SIZE[StringBody]*£nvironment.bytesPerWord; 
string: LONG STRING s Space.ScratchMap[bufPages]; 

Stringt <- [ 
length: 0, 

maxlength: bufPages*Environment.bytesPerPage - stringOverhead, 
text: ]; 

WHILE string.length < string.maxlength DO 
got: CARDINAL; 

[bytesTransferred: got] «■ rs.get[ 
rs, 

[blockPointer: LOOPHOLE[@string.text], 
startlndex: string.length, stopIndexPlusOne: string.maxlength], 
rs .options 

! Stream.EndOfStream => [ 

got «- 0: string. length string. length + nextlndex; CONTINUE); 
UNWIND => [] «- Space .Unmap[string]]; 

IF got = 0 THEN { 

strlngProcfstring! UNWIND => [] «- Space .Unmap[string]]; 

[] «■ Space.Unmap[string]; RETURN); 
string . length «- string, length + got; 

ENDLOOP; 

[] <- Space.Unmap[string] ; 

OthelloDefs.AbortingCommand["Command file too long!"L]; 

ENDLOOP); 
rawWrite = >{ 

buffer: LONG POINTER = Space.ScratchMap[1]; 
done: BOOLEAN <- FALSE; 
first: BOOLEAN <• TRUE; 

options: Stream. InputOptions <- rs.options; 

GetPage: PROC RETURNS [LONG POINTER] = { 
got: CARDINAL; Index: CARDINAL «- 0; 

IF first THEN {SIGNAL StartFeedback; first «- FALSE); 

WHILE -done DO 

[bytesTransferred: got] «- rs.get[ 
sH; rs, 

block: [blockPointer: buffer, startlndex: index, 
stopIndexPlusOne: Environment.bytesPerPage], 
options: options 

! Stream.EndOfStream 3 > {got <- nextlndex; done «- TRUE: CONTINUE)]; 

IF (index «■ index + got) = Environment.bytesPerPage 
OR done THEN {OthelloDefs.FIipCursor[]; EXIT) 

ENDLOOP; 

RETURN[IF done AND index = 0 THEN NIL ELSE buffer]); 
options . signal EndOfStream *■ TRUE; 

1 inkProc[GetPage ! UNWIND => [] <- Space.Unmap[buffer]]; 

WHILE -done DO [] «* GetPage[! UNWIND => [] <- Space.Unmap[buffer]] ENDLOOP; 
[] «■ Space .Unmap[buffer]) ; 

ENDCASE => ERROR}; 

Initial Ucode Fetch Command 

FetchlnitialMicrocode: PUBLIC PROC [ 

Instal1Proc: PROC [getPage: PROC RETURNS [LONG POINTER]]] = { 

CheckOpen[]; 

OthelloDefs.GetName["File name: "L, @fileName]; 

OthelloDefs.Conf1rm[]; 

current.Retrieve[fileName, [rawWrite[Instal1Proc]]]); 

Command Files 

AlternateGetCMFile: PUBLIC PROC [s: LONG STRING] = { 
z.FREE[@cmF11e]; 

cmFile z .NEW[StringBody[s. length+8]] ; 

FOR 1: CARDINAL IN [1..s.length) DO 

Strlnq.AppendChar[cmFi1e, s[i]] ENDLOOP; 

Dolndirect[]); 

Indirect: PROC = { 

OthelloDefs.MyNameIs[ 

myNamels: "0", myHelpIs: "Run command fi1e"L]; 

OthelloOefs.GetName["Command file: "L, @cmF11e 
! OthelloDefs.Question => { 

OthelloDefs.WriteL1ne["[Host]<D1r>Filename"L]; RESUME}]; 
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DoIndirect[]}; 


Dolndirect: PROC = { 

['| «- String.AppendExtensionIfNeeded[@cmFile , "othello"L, z]; 

FOR h: Handle «■ list, h.next UNTIL h = NIL DO 
IF h.DoIndirect[cmFile] THEN RETURN; 

ENDLOOP; 

OthelloDefs.AbortingCommand["Unrecogn1zab1e command file name"L]}; 


-- Misc, commands 

nProcesses, maxProcesses: NATURAL «- LAST[NATURAL]; 
finished: CONDITION; 

ForkUnmap: ENTRY PROCEDURE [buffer; LONG POINTER] = 

BEGIN 

BEGIN ENABLE Process.TooManyProcesses => {maxProcesses <- nProcesses; RETRY}; 

WHILE nProcesses >= maxProcesses DO 
WAIT finished; ENDLOOP; 

Process.Detach[LOOPHOLE[FORK DoUnmap[buffer]]]; 
nProcesses *■ nProcesses+l; 

END; 

END; 

DoUnmap; ENTRY PROCEDURE [buffer; LONG POINTER] = 

--buffer «- Space.Unmap[buffer, return]; 

BEGIN 

buffer *■ Space .Unmap[buf fer] ; 
nProcesses MAX[nProcesse$-l, 0]; 

NOTIFY finished; 

END; 

CloseCmd: PROC = { 

OthelloDefs,MyNamels[ 

myNamels: ''Close"L, myHelpIs: "Close currently open connection"L]; 

C1oseFetch[]}; 

C'loseFetch: PUBLIC PROC = { 

Select[NIL]}; 

LlstCmd: PROC = { 

OthelloOefs,MyNameIs[ 

myNamels: "List Files"L, myHelpIs: "Enumerate files matching pattern"L]; 

CheckOpen[]; 

OtheiloDefs.GetName["Pattern: "L, OflleName 
! OtheiloDefs.Question => { 

OthelloDefs.WrlteLine["pattern to match"L]; RESUME}]; 
current.List[f11eName]}; 

CheckOpen: PROC = { 

IF current = NIL THEN 

Othei 1 oDefs .AbortingCommand[’'You must execute an Open command flrsf'L]}; 

SotLeaderPage: PUBLIC PROCEDURE [file: File.File, note: LONG STRING] = 

BEGIN 

Ip; LONG POINTER TO Othei 1 oDefs. LeaderPage «- Space .Map[[f1 le. 0, Othe 11 oDefs . leaderPages]] .poi nter ; 
lp.version *■ Othei 1 oDefs . lpVersion ; 

Ip.length «* MlN[note. 1 ength, OthelloDefs. ipNoteLength]; 

FOR i: CARDINAL IN [0..1p.1ength) DO 
lp.note[i] *■ note[i]; 

ENDLOOP; 

[] *■ Space.Unmap[lp] ; 

END; 


-- command processor 

commandProcessor; Othei loDef s .CommandProcessor *• [FetchCommands]; 

FetchCommands: PROC [index: CARDINAL] = { 

SELECT index FROM 
0 => Ind1rect[]; 

1 => ClearinghouseCmd[]; 

2 => CloseCmd[]; 

3 => Directory[]; 

4 => FetchBoot[]; 

5 a > FetchDiagnosticMicrocode[]; 

6 => FetchGerm[]; 

7 => FetchPilotMicrocode[]; 

8 3 > L1stCmd[]; 

9 => LoginCmd[]; 

ENDCASE => OtheiloDefs.IndexTooLarge}; 

-- init 

OthelloDefs.ReglsterCommandProc[@commandProcessor]; 

END. 

Log 

5-Jun-86 12:25:59 NFS Adapted for OthelloTool 
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Copyright (C) 1984 by Xerox Corporation. All rights reserved. 

-- OthelloFloppy.mesa 

L.XR 10-Feb-84 16:25:51 

KXJ 27-Feb-84 17:17:08 

DIRECTORY 

AccessFloppy USING [ 

Attributes, AttributesRecord, Close, Error, ErrorType, GetAttributes, 

1eaderLength, Lookup. maxOataSize. Open, tFloppyLeaderPaqe, Timel, 

Ascii USING [CR, SP], 

Environment USING [bytesPerPage, bytesPerWord], 

Heap USING [systemZone], 

File USING [File, nullFile, PageNumber, SetSize], 

Floppy USING [ 

Error, ErrorType, FileHandle, GetFileAttrlbutes. GetNextFile, nullFIlelD, 
nullVolumeHandle, PageNumber, Read, ValumeHandle], 

Format USING [Char, Date, Decimal, StringProc], 

NSFile USING [String], 

OthelloDefs USING [ 

AbortingCommand, CheckUserAbort, CommandProcessor, FlipCursor, 

IndexTooLarge, leaderPages, MyNamels, RegisterCommandProc, 

SetCommandString, SetCursor, WriteLlne, WriteStrlng], 

OthelloFetch USING [Destination, Object, Register, Select, SetLeaderPage], 

Process USING [Detach], 

Space USING [Map, ScratchMap, Unmap], 

String USING [ 

AppendCharAndGrow, AppendLongDecImal, AppendStringAndGrow, 

CopyToNewString, Length, LowerCase], 

Time USING [Append, Unpack], 

Volume USING [ID, InsufficientSpace]; 

OthelloFloppy: PROGRAM 
IMPORTS 

AccessFloppy, File, Floppy, Format, Heap, OthelloDefs, OthelloFetch, 

Process, Space, String, Time, Volume = 

BEGIN 

Dolndlrect: PROC [cmFile: LONG STRING] RETURNS [mine: BOOLEAN] = 

BEGIN 

S: LONG STRING * NIL; 

GetString: PROC [c: LONG STRING] = {$ «- String.CopyToNewString[c, Heap. systemZone]}; 
IF cmFi1e[0] = ’[ THEN RETURN [FALSE]; 

OthelloFetch.Select[@fetcher]; OpenFloppy[]; 

Retrieve[cmFile, [string[GetString]] 

! UNWIND => Heap.systemZone.FR£E[@s]]; 

OthelloDefS.Wr1teLine["done"L]; 

OthelloDefs.SetCommandString[s]; 

RETURN[TRUE] 

END; 


-- MISC Stuff/Commands 

floppy: Floppy.Vol umeHandle +■ Floppy. nul IVol umeHandle: 

FloppyOpen: PROC RETURNS [BOOLEAN] = INLINE (RETURN[floppy » FIoppy.nul1VolumeHandle]} ; 

OpenCmd: PROC = { 

OthelloDefs.MyNameIs[myNameIs: "Floppy Open"L, myHelpIs: "Prepare to read files from floppy"L]; 
OthelloFetch.Select[@fetcher]; 

OpenFloppy[]}; 

OpenFloppy: PROC = { 

floppy «* AccessFloppy .Open[ 

! AccessFloppy.Error => OthelloDefs.AbortingCommand["Can't open floppy"L]; 

Floppy.Error 3 > (FIoppyError[error]; RETRY}]}; 

CloseFloppy: PROC = { 

AccessFloppy.Close[ 

! AccessFloppy.Error, Floppy.Error => CONTINUE]; 
floppy *■ Floppy. nul lVolumeHandle} ; 

FloppyLlst: PROC [pattern: LONG STRING] = { 

ListFiles[IF String.Length[pattern] - 0 THEN NIL ELSE pattern]}; 


-- Central commands 

commandProcessor: OthelloDefs .CommandProcessor <- [FloppyCommands]: 

FloppyCommands: PROC [index: CARDINAL] = { 

SELECT index FROM 
0 => OpenCmd[]; 

ENDCASE => OthelloDefs.IndexTooLarge}; 

■fetcher: OthelloFetch .Object [ 

Retrieve: Retrieve, 

Dolndlrect: Dolndirect, 

List: FloppyList, 

Close: CloseFloppy]; 


-- file retrieval Stuff/Commands 
EnumProe: TYPE = PROCEDURE [ 
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attributes: AccessFloppy.Attributes, fH; Floppy.FileHandle, name: LONG STRING] 

RETURNS [stop: BOOLEAN FALSE]; 

LIstFiles: PROCEDURE [pattern: LONG STRING] = 

BEGIN 

Write: Format.StrlngProc = {OthelloDefs.WriteStrlng[s]}; 

ListOne: EnumProc = 

BEGIN 

Write[name]: 

FOR i: CARDINAL IN [name.1ength + WritePartlal[Write. attributes]..40) DO 
Format.Char[Write, Ascii.SP]; ENDLOOP; 

Format.Date[Write, attributes.createDate, full]; 

Format,Char[Write, Ascii.CR]; 

END; 

EnumerateFloppyF11es[List0ne. pattern ]; 

END; 

WritePartial: PROCEDURE [Write: Format.StrlngProc, attributes: AccessFloppy.Attributes] 
RETURNS [chars: CARDINAL <- 0] = 

BEGIN 

CountedNumber: PROCEDURE [n: LONG CARDINAL] RETURNS [CARDINAL] = { 
s: STRING = [12]; 

String.AppendLongDecimal[s, n]; 

Write[s]; 

RETURN[s.length]}; 

IF attributes. of fset # 0 OR attributes . size ft attributes . total Size THEN { 
chars <- 4; 

Format.Char[Write, '[]; 

chars «• chars + CountedNumber[attributes .offset]; 

Write[".."L]; 

chars «* chars + CountedNumber[attributes.offset+-attributes .size-L]; 

Format.Char[Write. ']]}; 

END; 

EriumerateFloppyFiles : PROCEDURE [ 

proc: EnumProc, pattern: LONG STRING «- NIL] = 

BEGIN 

nullFile: Floppy.FileHandle <- [volume: floppy, file: FI oppy . null Fi 1 elD] ; 
attributes: AccessFloppy .Attributes *■ Heap. systemZone. NEW[ 

AccessFloppy.AttributesRecord[AccessFloppy.maxDataSize]]; 
name: LONG STRING a LOOPHOLE[@attributes.length]; 

BEGIN ENABLE Floppy.Error => { 

FloppyError[error] ; nullFile. volume *■ floppy; RETRY}; 

FOR current: FI oppy. Fi 1 eHandl e «- 

Floppy.GetNextFile[nu1lFile].nextFile, 

Floppy.GetNextF11e[current].nextFile 
WHILE current^nullFi1e DO 

ENABLE UNWIND => Heap.systemZone.FREE[0attributes]; 

OthelloDefs.ChecRUserAbort[]; 

IF Floppy.GetFileAttributes[current] . type ft AccessFloppy. tFloppyLeaderPage THEN LOOP; 
AccessFloppy.GetAttributes[current, attributes]; 

IF (pattern = NIL OR MaskFi1ename[fHe: name, mask: pattern]) 

AND proc[attributes, current, name] THEN EXIT; 

ENDLOOP; 

END; -- ENABLE 

Heap.systemZone. FREE[@attributes]; 

END; 

MaskFilename: PROCEDURE [ 

file: LONG STRING, filelndex: CARDINAL <- 0, mask: LONG STRING, 
masklndex: CARDINAL <- 0] 

RETURNS [BOOLEAN] = 

BEGIN 

-- local variables 
i, j: CARDINAL; 
wildString: CHARACTER = 
wildChar: CHARACTER = 

-- process each character in mask 
FOR i IN [masklndex..mask.length) DO 
SELECT mask[i] FROM 

wildString => -- matches any string of zero or more characters 

BEGIN 

FOR j IN [filelndex..file.length] DO 

IF MaskFilename[file, j, mask, i + 1] THEN 
RETURN[TRUE]; 

ENDLOOP; 

RETURN[FALSE]; 

END; 

wildChar => -- matches any single character 

IF filelndex = file.length THEN RETURN[FALSE] 

ELSE filelndex *- filelndex + 1; 

ENDCASE => 

IF filelndex = file.length 

OR String . LowerCase[f1 le[f ilelndex]] ft Str ing. LowerCase[mask[ i]] THEN 
RETURN[FALSE] 

ELSE filelndex <- filelndex + 1; 

ENDLOOP; 

-- filename passes mask if entire filename has been consumed 
RETURN[filelndex = f11e,1ength]; 

END; 

StartFeedback; SIGNAL = CODE: 

-- must fix Retrieve to deal with boot files that is in pieces 

Retrieve: PROC [fileName: LONG STRING, destination: Othel1oFetch.Destination] = { 
segmentPages, totalPages, bytes, offset: LONG CARDINAL; 
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name: LONG STRING «■ NIL; 

BEGIN 

ENABLE Floppy.Error => {FloppyErrorferror]; RETRY}; 
fH: Floppy.FileHandle «- [floppy. Floppy.nullFilelD]; 

[fh: fH, offset: offset, segmentPages: segmentPages, totalPages: totalPages, bytes: bytes, name: name] <- GetF11e[flleName]: 
GrabBits[ 

fH: fH, offset: offset, segmentPages: segmentPages, 

totalPages: totalPages, sizeBytes: bytes, destination: destination, 

note: name ! 

StartFeedback => { 

Othe11oDefs.WriteString["Fetching..."L]; 

Othel1oDefs.SetCursorfftp]; 

RESUME}; 

UNWIND => {OthelloDefs.SetCursor[pointer]; Heap.systemZone.FREE[@name]}] ; 

Heap . systemZone.FREE[©name]; 

Othel1oDefs.SetCursor[pointer]; 

END}; 

GetFlle: PROC [fileName: LONG STRING] RETURNS [ 

fh: Floppy.FileHandle, offset, segmentPages, totalPages, bytes: LONG CARDINAL, name: LONG STRING] = 

BEGIN 

time: LONG STRING «■ [20]; 

attributes; AccessFloppy.Attributes <- Heap.systemZone.NEW 
[AccessFloppy.AttributesRecord[AccessFloppy.maxDataSize]]; 
name «■ Heap . systemZone . NEW[Str1rtgBody[60]] ; 

{ENABLE UNWIND = > 

{Heap.systemZone.FREE[0attr1butes]; Heap.systemZone. FR£E[@name]}: 
fh «* AccessFloppy.LookUp{ 

MakeNSString[fileName], attributes 
? AccessFloppy.Error => 

SELECT type FROM 

fileNotFound => OthelloDef$,AbortingCommand["No such file"L]; 
volumeNotOpen => { 

CloseFloppy[]; 

OpenFloppyf]; 

RETRY}; 

ENOCASE => OthelloDefs.AbortingCommand[ "Unexpected access floppy problem"L]; 

Floppy.Error => {FloppyError[error]; RETRY}]; 

String. AppendStringAndGrow[ 

@name, LOOPHOLE[Qattributes.length], Heap.systemZone]; 

String.AppendStr1ngAndGrow[@name, " ("L, Heap.systemZone]; 

Time.Append[time, T1me.Unpack[attributes.createDate]]; 

String.AppendStringAndGrow[0name, time. Heap,systemZone]; 

String.AppendCharAndGrow[@name, '), Heap.systemZone]; 

offset «• attributes .offset; 

segmentPages «• attributes . size : 

totalPages <- attributes. total Size; 

bytes «- attributes.totalSIzelnBytes: 

Heap.systemZone.FRE£[@attributes]}; 

END; 

MeikeNSString: PROCEDURE [s: LONG STRING] RETURNS [NSFIle.String] = { 

IF s = NIL THEN RETURN[[bytes: NIL, length: 0, maxlength: 0]]; 

RETURN[[bytes: LOOPHOLE[©s.text], length: s.length, maxlength: s.maxiength]]}; 

bufPages: CARDINAL = 8; 

GrabBIts: PROC [ 

fH: Floppy.FileHandle, offset, segmentPages, totalPages: LONG CARDINAL., 
sizeBytes: LONG CARDINAL, destination: Othel1oFetch.Destination, 
note: LONG STRING <- NIL] = { 
base: File.PageNumber «- 0; 

WITH destination SELECT FROM 
pilotFileSystemWrite => { 
buffer: LONG POINTER <- NIL: 

File.SetSlze[localFile, totalPages + OthelloDefs.leaderPages 
! Volume.InsufficIentSpace => OthelloDefs.Abort1ngCommand[”Volume FulV'L]]; 

Othe11oFetch.SetLeaderPage[localFile, note]: 

SIGNAL StartFeedback; 

WHILE base < segmentPages DO 

thisPages: CARDINAL = CARDINAL[MIN[segmentPages-base. bufPages]]: 
buffer «■ Space.Map[ 

window:[localFile, offset+base+Othel1oDefs.leaderPages, thisPages], 
life: dead] .pointer; 

Floppy.Read[fH, base+AccessFloppy.leaderLength, thisPages, buffer ! 

Floppy.Error => FloppyError[error]; 

UNWIND => [] <• Space ,Unmap[buffer]] ; 

--buffer Space.Unmap[buffer, return]; 

Process . Detach[LOOPHOLE[FORK Space ,Unmap[buffer]]] ; buffer *■ NIL; 

Othel1oDefs.FI1pCursor[]; 
base *- base + thisPages; 

ENDLOOP}; 
string *> { 

thisPages: CARDINAL = CARDINAL[MIN[segmentPages-base, bufPages]]; 
stringOverhead: CARDINAL = SIZE[StringBody]*Env1ronment.bytesPerWord; 

String; LONG STRING «■ NIL; 

IF segmentPages base > thisPages THEN 

Othel 1 oDefs .Abort1ngCommand[''Command file too long ! "L] ; 

SIGNAL StartFeedback; 

string <■ Space . ScratchMap[thisPages + l] ; 

stringt <- [ 

length: CARDINAL[sizeBytes], 

maxlength: bufPages*Environment.bytesPerPage - stringOverhead, 
text: ]; 

Floppy.Read[fH, base+AccessFloppy.leaderLength, thisPages, ©string.text ! 

Floppy.Error => FloppyError[error]; 

UNWIND -> [] *■ Space ,Unmap[string]j ; 
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stringProc[str1ng]; 

[] <- Space.Unmap[string]} ; 
rawWrlte =>{ 

buffer: LONG POINTER - Space.ScratcbMap[1]; 
count: CARDINAL * 0; 

GetPage: PROC RETURNS [LONG POINTER] = { 

IF count = 0 THEN SIGNAL StartFeedback; 

IF count = segmentPages THEN R£TURN[NIL]; 

Floppy.Read[fH, base+count+AccessFloppy.leaderLength, 1, buffer ! 
Floppy.Error => FIoppyError[error]; 

UNWIND => [] <- Space.Unmap[buffer]]; 
count «• count + 1; 

OthelloDefs.FI1pCursor[]; 

RETURN[buf fer]}; 

11nkProc[GetPage ! UNWIND => [] «- Space .Unmap[buffer]]; 

[] <■ Space.Unmap[buffer]} ; 

ENDCASE => ERROR}; 

FloppyError: PROC [error: Floppy.ErrorType] = 

BEGIN 

myProc: Format.StringProc = [OthelloDefs.WriteString[s]}; 

SELECT error FROM 

InvalIdVolumeHandle => { 

AccessFloppy.Close[! AccessFloppy.Error, Floppy.Error => CONTINUE]; 
OpenFloppy[]; RETURN}; 

notReady => Othel1oDefs.AbortingCommand["Can 1 t open floppy"L]; 
badDlsk. badSectors. hardwareError => 

OthelloDefs.AbortingCommand["Floppy hardware problem"L]; 
invalIdFormat, invalidPageNumber, needsScavenging => 

OthelloDefs.AbortingCommand["Floppy not readable"L]; 

ENDCASE => { 

OthelloDefs.WrlteString["Floppy error "L]; 

Format.Decimal[myProc, error.ORD]}; 

OthelloDefs.AbortingCommand[NIL] 

END; 


-- initialization 

OthelloDefs.RegisterCommandProc[@commandProcessor]; 
OthelloFetch.Reg1ster[@fetcher]; 

END. 
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-- NFS 5-Jun-86 14:20:34 
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Igr 13-Feb-84 15:31:26 

rkj 24-Feb-84 18:36:31 

-- Copyright (C) 1984, 1985 by Xerox Corporation. All rights reserved. 

DIRLCTORY 

AddressTraosIation USING [Error, PrintError, StrlngToNetworkAddress], 

Auth USING [Freeldentity, IdentityHandle, Makeldentity], 

--CH USING [MakeRhs], 

Courier USING [ErrorCode, Error], 

NSErrorMsg USING [PostCourierError, PostNSFi1eError], 

Heap USING [systemZone], 

Format USING [Str1ngProc], 

NSDataStream USING [Abort, Aborted, Handle, SourceStream], 

NSFIle USING [ 

AttributesProc, AttributesRecord, Close, Error, ErrorRecord, Find, GetAttrlbutes, 
Handle, List, Logoff, LogonDirect, maxStrlngLength, nullHandle, nullSession, Open, 
Retrieve, Scope, Selections, ServiceRecord, Session, String, Time], 

NSName USING [ 

AppendNameToStrlng, Error, FreeNameFields, maxOomainLength, maxFul1NameLength, 
maxOrgLength, Name, NameFieldsFromString, NameRecord, String], 

OthelloDefs USING [ 

AbortingCommand, CheckUserAbort, CommandProcessor, GetName, 

IndexTooLarge, MyNamels, RegisterCommandProc, SetCommandString, 

SetCursor, WrlteChar, WriteLine, WriteString], 

OthelloFetch USING [ 

Destination, directory, Handle, GrabBitsFromStream, Object, Register, Select, 
StartFeedback], 

Profile USING [GetDefaultDomain, GetDefaultOrganization, GetUser, String], 

Stream USING [Delete, Handle], 

String USING [ 

AppendChar, AppendCharAndGrow, AppendNumber, AppendString, AppendStrlngAndGrow, 
CopyToNewString, Empty, Length, Str ingBoundsFault. Substring, SubStringDescriptor], 
Time USING [Append, Unpack]; 

OthelloNSFTP: PROGRAM 
IMPORTS 

AddressTranslation, Auth, --CH,-- Courier, NSErrorMsg, Heap, 

NSDataStream, NSFIle, 

NSName, OthelloDefs, OthelloFetch, Profile, Stream, String, Time = 

BEGIN 

host: LONG STRING «- NIL; 

nsFileSession: NSFile.Session «- NSFile.nullSession; 
z: UNCOUNTED ZONE = Heap.systemZone; 


String/Credentials Commands 


I don't believe we need this proc anymore; It no longer make sense to allow network addresses; must get to Auth server anyway; 

Qualify: PROC [token: LONG STRING] RETURNS [newToken: LONG STRING] = [ 
octal Address: BOOLEAN «- TRUE; — only '0..'7 and '# allowed 
chChar: CHARACTER = 

defaul tDomain , defaul tOrganization : LONG STRING *■ NIL; 

GetDomain: PROC[domain: LONG STRING] = 

(IF domain ¥ NIL THEN 

String.AppendStringAndGrow[@defaultDomain, domain, z]}; 

GetOrg: PROC[org: LONG STRING] = 

{IF org ¥ NIL THEN 

String.AppendStringAndGrow[@defau1tOrganization. org, z]}; 

IF String.Length[token] = 0 THEN RETURN[NIL]; 

FOR i: CARDINAL IN [0..token.1ength) DO 
SELECT token[1] FROM 

chChar => (RETURN[String.CopyToNewString[token, z]]}; -- already qualified 
IN[ ’ 0 . .*7], '# => NULL; 

ENDCASE => octal Address *■ FALSE; 

ENDLOOP; 

newToken Stri ng ,CopyToNewString[token , z]; 

IF octalAddress THEN RETURN; 

Profile.GetDefaultDomain[GetDomain]; 

Prof1le.GetDefaultOrganization[GetOrg]; 

IF String.Length[defaultDomain] > 0 OR 

String.Length[defaultOrganization] > 0 THEN { 

String.AppendCharAndGrow[@newToken, chChar, z]; 

String.AppendStringAndGrow[@newToken, defaultDomain, z] ; 

String.AppendCharAndGrow[@newToken, chChar, z]; 

String.AppendStringAndGrow[@newToken, defaultOrganization , z]}; 
z.FREE[©defaultDomain]; 
z.FREE[@defaultOrganization]}; 

Dolndirect: PROC [cmFile: LONG STRING] RETURNS [mine: BOOLEAN] - 
BEGIN 

fileName: LONG STRING <- NIL: 

ParseCmFi1eName: PROC - [ 
hostEnd: CARDINAL; 

IF cmFile.length = 0 THEN RETURN; 

FOR i: CARDINAL IN [0..cmF1le.length) DO 
c; CHARACTER = cmF11e[i]; 

SELECT c FROM 

’[ = > LOOP; ’] => {hostEnd <- i; EXIT}; 

ENDCASE => String.AppendCharAndGrow[@host, c, z]; 
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REPEAT FINISHED => {z.FREE[Qhost]; RETURN} 

ENDLOOP; 

— hostEnd points at '] 

FOR i: CARDINAL IN (hostEnd..cmF11e.1 ength) DO 

IF cmFile[i] = ’< AND OthelloFetch.directory^NIL THEN 
Othel loFetch. directory. length «• 0; 

String.AppendCharAndGrow[@fIleName, cmF11e[1], z]; 

IF cmFile[i} = '> THEN { 

String.AppendStringAndGrow[ 

GOthelloFetch.directory. fileName, z]; 
fileName . length <- 0}; 

ENDLOOP}; 

s: LONG STRING «• NIL; 

GetString: PROC [c: LONG STRING] = {s +■ String .CopyToNewString[c, z]}; 

IF cmFile[0] # '[ THEN RETURN [FALSE]; 
z.FREE[@host]; 

z.FREE[SOthe11oFetch.directory]; 

ParseCmFlleName[]; 

OthelloFetch.Select[0fetcher]; Open[]; 

Retrieve[fIleName, [str1ng[GetString]j 

! UNWIND »> {z.FREE[@s]; z.FREE[@fileName]}]; 

OthelloDefs.WriteL1ne["done"L]; 

Othel loDefs .SetCommandStr1ng[s]; 
z.FREE[@fileName]; 

RETURN[TRUE] 

END; 


-- MTSC Stuff/Commands 

userOpened: BOOLEAN «■ FALSE; 

OpenCmd: PROC = { 

OthelloDefs.MyNameIs[ 

myNamels: "Open Connection"L, 

myHelpIs: "Open connection to file servlce"L]; 

OthelloFetch.Select[@fetcher]; 

OthelloDefs.GetName["Open connection to "L, @hcst]; 

Open[]; userOpened «- TRUE}; 

Reopen: PROC RETURNS [BOOLEAN] = { 

IF userOpened=FALSE THEN RETURN[FALSE]; 

Open[] ; RETURN[TRUE]}; 

RemoteLlst: PROC [fileName: LONG STRING] = [ 

IF ~ConnectionOpen[] AND ~ReOpen[] THEN 

OthelloDefs.AbortingCommand["Please open a connection"L]; 
ListFiles[IF String.Length[fileName] = 0 THEN "+"L ELSE fileName]}; 


-- Central commands 


commandProcessor: Othel 1 oDefs .CommandProcessor «- [FtpCommands] ; 

FtpCommands: PROC [Index: CARDINAL] = { 

SELECT index FROM 
0 => OpenCmd[]; 

ENDCASE => OthelloDefs.IndexTooLarge}; 

fetcher: Othel loFetch .Object «- [ 

Retrieve: Retrieve, 

Dolndlrect: Dolndlrect, 

List: RemoteLlst, 

Close: Close]; 


-- file retrieval Stuff/Commands 


ConnectlonOpen; PROC RETURNS [BOOLEAN] = [ 

RETURN[nsF11eSession # NSF11e.null Session]}; 

-- all callers close the connection first 
Open: PROC = { 

cllentDefaultsRecord: NSName.NameRecord; 
defaultCHOrg: LONG STRING = [NSName.maxOrgLength] ; 
defaultCHDomain: LONG STRING = [NSName.maxDomainLength]; 
serviceName: LONG STRING «■ [NSName . maxFul INameLength] ; 
servIceRec: NSF1 le .ServiceRecord «- []; 
nameRecord: NSName .NameRecord «- []; 

Id: Auth. IdentltyHandle «* NIL; 

GetDomain: PROC[doma1n: LONG STRING] = { 

String.AppendString[defaultCHOomain, domain ! 

String.StringBoundsFault => RESUME[NIL]]>; 

GetOrg: PROC[org: LONG STRING] = [ 

String.AppendString[defaultCHOrg, org ! 

String.StringBoundsFault => RESUME[NIL]]}; 

AppendNameToString: PROCEDURE [s: LONG STRING, name: NSName.Name] : { 
newS: NSName . String «- NSName . AppendNameToString[s : S[s], name: name]; 
s.length «- newS.length}; 

CopyUserAndPassword: PROCEDURE[name, password: LONG STRING] = { 
userName «- String.CopyToNewString[name, z]; 
userPassword «- String ,CopyToNewString[password , z]; 

}: 

Cleanup: PROCEDURE = { 

Auth.Freeldentity[@id, z]; 
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z.FREE[@userName]I z.FREE[@userPassword]; 

NSNamo.FreeNameF1elds[z, OserviceRec.name]; 

NSName,FreeNameFields[z, OnameRecord]} ; 

userName, userPassword: Prof 11 e.String «■ NIL; 

IF nsFileSesslon ft NSFile.nullSesslon THEN RETURN; 

Prof lie.GetDefaultDomain[GetDomain] ; 

Profile.GetDefaultOrganization[GetOrg]; 

clientDefaultsRecord «■ [domain: S[defaul tCHDomain], org: S[defaul tCHOrg]] ; 

NSName.NameF1e1dsFromString[ 

z: z, s; S[host], destination: @serviceRec.name, 
cllentDefaults: @c1 lentDefaultsRecord ! 

NSName.Error => OthelloDefs.Abort1ngCommand["inegal host name"L]]; 

AppendNameToString[serviceName, OserviceRec.name]; 

Profile.GetUser[CopyU$erAndPassword, clearinghouse]; 

NSName.NameFieldsFromString[ 

z: z, s: S[userName], destination: SnameRecord, 
clIentDefaults: @clientDefaultsRecord ! 

UNWIND => NSName.FreeNameFields[z, QserviceRec.name]; 

NSName.Error => OthelloDefs.Abort1ngCommand["niegal login name"L]]; 

id <- Makeldentity[name: SnameRecord, password: userPassword]; 

(ENABLE UNWIND => Cleanup[]; 

serviceRec.systemElement «• AddressTranslat1on.StringToNetworkAddress[ 
s: serviceName, id: id ! 

AddressTranslatlon.Error => { 
msg: LONG STRING <- [100]; 
appendErrorMsg: Format.StringProc = { 

String.AppendString[msg. s ! String.StringBoundsFault => RESUME[NIL]]}; 
AddressTranslation.Pr1ntError[error: errorRecord, proc: appendErrorMsg]; 
Othel1oDef s.Abort1ngCommand[msg]}].addr; 

nsFileSesslon *■ NSFile.LogonDirect[ 
identity: id. service: QservlceRec 
I NSFile.Error => NSError[error]; 

Courier.Error => CourierError[errorCode]]; 

Cleanup[]}}; 

Makeldentity: PROC [name: NSName.Name, password: LONG STRING] 

RETURNS [ident: Auth.IdentityHandle] = ( 

Ident *■ Auth„MakeIdentity[ 
myName: name, password: S[password], 
z: z, style: simple, dontCheck: TRUE]}; 


Close: PROC = ( 

IF ^ConnectionOpen[] THEN RETURN; 

NSFile.Logoff[nsF11eSession 

! NSFile.Error => NSError[error]; 

Courier.Error => CourierError[errorCode]; 

OthelloDefs.AbortingCommand => { 

OthelloDef s.WriteString[reason]; 

OthelloDef s.WriteLine[reasonOne]; 

CONTINUE}]; 

nsFileSesslon «- NSFile.nullSesslon; 

OthelloDefs.WriteL1ne["connection c1osed"L]}; 

-- could mess with directories. 

-~ who cares 

ListFiles: PROC [pattern: LONG STRING]= ( 
scope: NSFile.Scope «• []; 
selections: NSFile.Selections *■ []; 
fh: NSFile.Handle; 
dir: LONG STRING «■ NIL; 
wildCardlnFileName: BOOLEAN «- FALSE; 
name: LONG STRING «■ NIL; 

ss: String.SubStringDescriptor <- [base: NIL. offset: 0. length: 0]; 

ListOne: NSFile.AttrlbutesProc 2 ( 
version: LONG STRING «■ [20]; 
time: LONG STRING «■ [20]; 

Time.Append[time, Time.Unpack[attributes.createdOn]]; 

String.AppendChar[version, '!] ; 

String.AppendNumber[vers ion, attributes.version]; 

<< FOR i: CARDINAL IN [0..attributes.pathname.length) DO 

OthelloDefs.WriteChar[VAL[attributes.pathname.bytes[i]]]; 

ENDLOOP;>> 

OthelloDefs.Wr1teString[dir]; 

FOR 1; CARDINAL IN [0attributes.name.1ength} DO 
OthelloDefs,Wr1teChar[VAL[attributes.name.bytes[1]]]; 

ENDLOOP: 

OthelloDefs.WriteStr1ng[vers ion]; 

THROUGH [dir.length + attributes.name.1ength + version.length,,80-time.length) 
DO OthelloDefs.WriteChar[' ] ENDLOOP; 

OthelloDefs.WriteLlne[time]; 

--OthelloDefs.WriteCharf' ]; 

--OthelloDefs.Wr1teLine[1nfo.author]; 

--OthelloDefs.WriteChar[* ]; 

--OthelloDef s.WriteLongNumberfinfo.size]; 

--OthelloDefs.WriteLine[" bytes]"L]; 

OthelloDefs.CheckUserAbort[]; 

RETURN}; 

dir «■ z.NEW[StringBody[60]]; 

IF pattern[0] ft '< AND String.Length[Othe11oFetch.directory] ft 0 THEN ( 

String.AppendStrlngAndGrow[@d1r, Othel!oFetch.directory, z]; 

IF dir[dir.length - 1] ft ’> THEN 
String.AppendCharAndGrow[@dir, ’>. z]}; 

String.AppendStringAndGrow[Qdir, pattern, z]; 
ss.base +■ dir; 
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FOR 1: CARDINAL DECREASING IN [0..dir.length) DO 
SELECT dir[i] FROM 

'* => wildcard I nFileName * TRUE; 

’> => {s$.length ♦■1 + 1; EXIT}; 

ENDCASE; 

ENDLOOP; 

name + z.NEW[StringBody[dir.length - ss.length]]; 

FOR I: CARDINAL IN [ss. length .. dir.length) DO 
String.AppendChar[name, dir[i]]; 

ENDLOOP; 

dir.length + ss.length; 

IF HasW11dCard£d1r] THEN { 
z.FREE[@dir]; 
z. FREE[@name]; 

OthelloDefs.AbortingCommand["No wild cards In directories."L]}; 
fh + GetFileFromSS[ss]; 

IF fh = NSFile.nullHandle THEN { 

z.FRE£[@name]; z.FREE[@dir]; RETURN}; 
scope.filter + IF wlldCardlnFileName THEN 
[matches[[name [S[name]]]]] 

ELSE [equal[[name [S[name]]]]]; 
selections.1nterpreted[name] + TRUE; 
selections.1nterpreted[version] + TRUE; 
selections. interpreted[createdOn] «- TRUE; 

selections.1nterpreted[pathname] + TRUE; -- not yet implemented 
NSFile.List[ 

directory: fh, proc: ListOne, selections: selections, scope: scope, 
session: nsFileSession 

! NSFile.Error => NSError[error]; 

Courier.Error => CourierError[errorCode]; 

UNWIND => {z.FREE[@name]; z.FREE[@dir]}]; 
z.FREE[@d1r]; 
z,FRE£[@name]; 

}; 


Retrieve: PROC [ 

fileName: LONG STRING, destination: OthelloFetch.Destination] = { 

Size: LONG CARDINAL; 

name: LONG STRING + NIL: 

fH: NSFile.Handle ♦ NSFile.nulIHandle; 

Sink: PROC [source: NSDataStream.SourceStream] = 

BEGIN ENABLE { 

NSDataStream.Aborted => {Stream.Delete[source]; CONTINUE}; 

UNWIND => Stream.Delete[source]}; 

OthelloFetch.GrabBitsFromStream[source, size, destination, name ! 

OtheiloFetch.StartFeedback -> { 

OthelloDefs.WriteStr1ng["Fetching..."L]; 

Othel1oDef s.SetCursor[ftp]; 

RESUME}; 

UNWIND => { 

OthelloDefs.SetCursor[pointer]; 

NSDataStream.Abort[source ! NSDataStream.Aborted => CONTINUE]}]; 

Stream.Delete[source ! NSDataStream.Aborted => CONTINUE] 

END; 

[fH. size, name] + GetFile[fileName]; 

NSFile.Retrieve[fH, [proc [Sink]], nsFileSession 
! UNWIND => 

{NSFile.Close[ 

fH, nsFileSession ! NSFile.Error, Courier.Error => CONTINUE]; 
z. FREE[@name]}]; 

NSFile.Close[fH, nsFileSession 

! NSFile.Error. Courier.Error => CONTINUE; 

UNWIND => z.FREE[@name]]; 
z.FREE[@name]; 

OthelloDefs.SetCursor[pointer]}; 

GatFIle: PROC [fileName: LONG STRING] RETURNS [fh: NSFile.Handle. size: LONG CARDINAL, name: LONG STRING] 
BEGIN 

time: LONG STRING + [20]; 
attributes: NSFile.AttributesRecord; 

ss: String .SubStrl ngDescrlptor <- [base: NIL, offset: 0, length: 0]; 
name + z.NEW[5tringBody[60]] ; 

String.AppendCharfname, '[]; 

String.AppendStringAndGrow[@name, host, z]; 

String.AppendCharAndGrow[@name, ’], z]; 
ss.offset + name.length: 

IF fileName[0] # '< AND -String.Empty[OthelloFetch.directory] THEN { 

String.AppendStringAndGrow[@name, Othel!oFetch.directory, z]; 

IF name[name.length - 1] # ’> THEN 

String.AppendCharAndGrow[@nanie , '>. z]}; 

String.AppendStringAndGrow[§name, fileName. z]; 
ss.base + name; 

ss.length + name.length - ss.offset; 
fh «- GetFileFromSS[ss]; 

NSF1le.GetAttributes[ 

fh, [[createdOn: TRUE, sizelnPages: TRUE]], 

Gattributes, nsFileSession 

! NSFile.Error => NSError[error]; 

Courier.Error => CourierError[errorCode]] ; 

String.AppendStr1ngAndGrow[@name, " ("L, z]; 

Time.Append[time, Time.Unpack[attributes.createdOn]]; 

String.AppendStringAndGrow[@name, time, z]; 

String,AppendCharAndGrow[@name, ’), z]; 
size * attributes.sizelnPages; 

END; 

GetFileFromSS: PROCEDURE [ss: String.SubStringDescriptor] RETURNS [fh: NSFile.Handle ♦ NSFile.nul1 Handle] 
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ENABLE {NSFile.Error => NSError[error]; 

Courier.Error => CourierError[errorCode]}; 
tempName: STRING = [NSF11e.maxStringLength]; 

parent: NSFile . Handl e «- NSFile.Qpen[attrlbutes: NIL, session: nsFileSesslon]; 
DO 

GetRoot[@ss, tempName]: 
fh <- NSFile.Find[ 
directory: parent, 
scope: [ 

direction: backward, filter: [equal[[name[S[tempName]]]]]], 
controls: [timeout: 4], session: nsFileSesslon ! 

UNWIND => NSFile.Close[parent, nsFileSesslon ! 

NSFile.Error, Courier.Error => CONTINUE]]; 

NSF11e.Close[parent, nsFileSession]; 

IF ss.length = 0 THEN EXIT; 

parent + fh 

ENDLOOP; 


GetRoot: PROC [fileName: String.Substring, root: LONG STRING] = { 

OPEN fileName: 

St.ripChar: PROC = INLINE (offset *- offset + 1; length + length - 1}; 

N: CARDINAL offset + length; 
quote : CHARACTER = ''; 
i: CARDINAL offset; 
root. length *- 0; 

WHILE i < N DO 

SELECT base[i] FROM 
quote => { 

i + 1 + 1; Str1pChar[]; IF 1 = N THEN EXIT; 

String.AppendChar[root, base[1]]}; 

'>, '/ => EXIT; 

'< => root.length + 0; 

ENDCASE => String.AppendChar[root, base[i]]; 

1 + i+1; 

StripChar[]; 

ENDLOOP; 

IF fileName.length = 0 THEN RETURN; 

StripChar[]}; 

S: PROCEDURE [s: LONG STRING] RETURNS [NSFile.String] = { 

IF s = NIL THEN RETURN[[bytes: NIL, length: 0, maxlength: 0]]; 

RETURN[[bytes: L00PH0LE[@s.text], length: s.length, maxlength: s.maxlength]]}; 

HasWildCard: PROC [s: LONG STRING] RETURNS [BOOLEAN] = ( 

IF s/PNIL THEN FOR i: CARDINAL IN [0..s.length) DO 
IF s[i] = ,+ THEN RETURN[TRUE] ENDLOOP; 

RETURN[FALSE]}; 


NSError: PROC [error: NSFi1e.ErrorRecord] = 

BEGIN 

post: Format.StringProc = (Othel1oDefs.WriteString[s]}; 
NSErrorMsg.PostNSFileError[error, post]; 

OthelloDefs.Abort1ngCommand[NIL]; 

END; 

CourierError: PROC [error: Courier.ErrorCode] = 

BEGIN 

post: format.StringProc = (Othel1oDefs.WrlteString[s]}; 
NSErrorMsg.PostCourierError[error, post]; 

OthelloDefs.AbortIngCommandfNIL]; 

END; 

<<StartCH: PROCEDURE = ( 

frame: PROGRAM <- Runt ime. Global Frame[LOOPHOL£[CH .MakeRhs]] ; 
START frame} ;» 


initialization 

OthelloDefs.RegisterCommandProc[@commandProcessor]; 
OthelloFetch.Reg ister[@fetcher]; 

—StartCHf]; 

END. 


Log 

NFS 4-Jun-86 13:04:55 Adapted for Othel1oTool. 
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-- File: OthelloNS.mesa - last edit: 

— BJD .PA 15-Feb-85 16:10:58 

— AOF 25-Jan-85 10:33:26 

-- Copyright (C> 1983 , 1985 by Xerox Corporation. All rights reserved. 

DIRECTORY 

AddressTranslation USING [Error, PrintError, StringToNetworkAddress]. 

Auth USING [IdentityHandle], 

NSBuffer USING [Body, Buffer, ReturnBuffer], 

ExtendedString USING [AppendNumber], 

Format USING [StrlngProc], 

Inline USING [HighByte, LowByte], 

NSConstants USING [echoerSocket], 

NSTypes USING [maxDataBytesPerEcho, wordsPerlDPHeader], 

OthelloDefs, 

Process USING [Detach, Pause, SecondsToTicks, Yield], 

Profile USING [GetID], 

Router USING [ 

FI 1IRoutingTable, GetDelayToNet, infinity, endEnumeration, startEhumeration, 
EnumerateRoutlngTable], 

Socket USING [ 

AssignNetworkAddress, Create. Delete, GetPacket, ChannelHandle, 

PutPacket, GetSendBuffer, SetPacketBytes, GetPacketBytes, 

SetWaitTime, TlmeOut], 

String USING [AppendStrlng, StringBoundsFault], 

System USING [NetworkAddress, SocketNumber, NetworkNumber, HostNumber]; 

Othel!oNS: PROGRAM 

IMPORTS AddressTranslation, NSBuffer, ExtendedString, Inline, Profile, Process, Router, 
String, Socket, OthelloDefs = 

BEGIN OPEN OthelloDefs; 

EchoUser: PROC = 

BEGIN 

bytesPerBuffer: CARDINAL; 
funny, late: LONG CARDINAL «- 0; 

recv, sent: LONG CARDINAL «■ 0: 

wrong: LONG CARDINAL *■ 0; 

me. where: System.NetworkAddress: 

mySoc: Socket.ChannelHandle: 

packetNumber: CARDINAL <- 0; 

pleaseStop: BOOLEAN «- FALSE; 

routing: CARDINAL; 

Watch: PROC = {[] *■ ReadChar[]; pleaseStop «■ TRUE}; 

PrintErrorNS: PROC [b; NSBuffer.Buffer] = { 
body: NSBuffer.Body «■ b.ns; 
source: System.NetworkAddress «- body.source; 

NewLIne[]; 

IF body.packetType = error THEN { 
len: CARDINAL = body.pktLength; 

WriteString["[Error packet, code="L]; 

WriteOctal[LOOPHOLE[body.errorType]]; 

WriteString[", from: "L]; 

PrintNSAddress[@source]; 

WriteString["] "L]; 

FOR i: CARDINAL IN [0..1en - NSTypes.wordsPerlDPHeader) DO 
Wr1teChar[Inline.LowByte[body,errorBody[i]]]; 

WriteChar[Inline.HighByte[body.errorBody[i]]]; 

ENDLOOP} 

ELSE { 

WrlteStringf" ***** "L]; 

WriteStr1ng["Funny packet type = "L]; 

WriteOctal[LOOPHOLE[body.packetType]] ; 

WriteString[" ***** "L]}; 

NewLine[]}; 

identity: Auth. IdentityHandle «• NIL; 

getID: PROC [id: Auth. IdentityHandl e] = (identity «- id}: 

GetName["Echo to: "L, QechoName]; 

Profile.GetID[simple, getID]; 

[where, ] <- AddressTranslation .StringToNetworkAddress[echoName, identity ! 
AddressTranslation.Error => { 
msg: LONG STRING «■ [100]; 
appendErrorMsg: Format.StringProc = ( 

String,AppendString[msg, s ! String.StringBoundsFault => RESUME[NIL]]}; 
AddressTranslation.PrintError[error: errorRecord, proc: appendErrorMsg]; 
OthelloDefs.Abort1ngCommand[msg]}]; 
where.socket +■ NSConstants .echoerSocket; 
routing «• Router .GetOelayToNet[where.net]; 

IF routing = Router.infinity THEN 

AbortingCommand[’ , Can't reach that network"L]; 

me <- Socket.AssignNetworkAddress[]; 
mySoc «- Socket ,Create[me, socket] ; 

Socket.SetWaitT1me[mySoc, 2000]; --two second timeout 
WriteString[". ["L]; PrintNSAddress[@me]: WrlteStringf"] => [”L]; 

PrintNSAddress[@where]: 

WriteCharf’]]; NewLinef]; 

Process.DetachfFORK Watchf]]; 
bytesPerBuffer *■ NSTypes .maxDataBytesPerEcho ; 

UNTIL pleaseStop DO 

FOR len: CARDINAL IN [4..bytesPerBuffer] UNTIL pleaseStop DO 
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b: NSBuffer.Buffer «■ Socket.GetSendBuffer[mySoc]; 
body: NSBuffer.Body «- b.ns; 
body .destination <- where: 

body.packetType *■ echo; body.echoType *■ echoRequest; 

Socket.SetPacketBytes[b. 1en]; 

FOR 1: CARDINAL IN [4..1en - 4) DO body. echoBytes[ 1 ] <- i; ENDLOOP; 

body.echoWords[0] «- body.echoWordsfl] *■ (packetNumber «- packetNumber + 1); 

Socket.PutPacket[niySoc, b]; sent «- sent + 1; 

Process.Y1eld[]; -- be sure we don't hog machine 

BEGIN 

b <- Socket,GetPecket[mySoc ! Socket.TimeOut s > GOTO late]; 

SELECT TRUE FROM 

(body.packetType ¥ echo) => 

{funny funny + I; PrintErrorNS[b]}; 

(body.echoWords[0] ¥ packetNumber) s > {WriteChar[ ’#]; late *■ late + I}; 
(body.echoWords[l] ¥ packetNumber) => {WriteChar[ ’#] ; late +■ late + I}; 
(len ¥ Socket .GetPacketBytes[b]) => (Wr1teChar[ '#]; late «- late + 1}; 
ENDCASE => 

FOR 1: CARDINAL IN [4..len - 4) DO 

IF body.echoBytesfl] ¥ {i MOD 400B) THEN 
{wrong «- wrong + 1; WriteChar[’-]; EXIT}; 

REPEAT FINISHED => {WriteCharf ' ! ] ; recv «• recv + 1}; 

ENDLOOP; 

NSBuffer.ReturnBuffer[b]; 

EXITS late => {Wr1teChar[ r ?]; late «■ late + l}; 

END; 

ENDLOOP; 

NewLine[]; 

ENDLOOP: 

Socket.Delete[my$oc]; 

WriteStr1ng["0ut: "L]; 

Wr1teLongNumber[sent]; 

WriteStr1ng[", In: "L]; 

Wr1teLongNumber[recv]; 

WriteString[" ("L]; 

WriteLongNumber[(recv* 100)/sent]; 

Wr1teL1ne["%)"L]; 

IF 1 ate ¥ 0 THEN { 

Wr1teStr1ng["Late: "L]; WriteLongNumber[late]; 

Wr1teString[" ("L]; WriteLongNumber[(1ate*100)/sent]; WriteL1ne["%)"L]}; 

IF funny ¥ 0 THEN {Wr1teLongNumber[funny]; Wr1teLine{" funny"L]}; 

IF wrong ¥ 0 THEN [WriteLongNumberfwrong]; Wr1teL1ne[" wrong data"L]}; 

END; 

PrintLocalRoutlngTable: PROC = 

BEGIN 

string: STRING *■ [20]; 
net: System.NetworkNumber; 

Router.FillRoutingTable[Router.Infinity]; --load 'em up 
Process.Pause[Process.SecondsToTicks[2]]; 

FOR hop: CARDINAL IN[0..Router.infInlty] DO 

net «• Router. EnumerateRouti ngTable[Router. startEnumeratlon , hop]; 

IF net = Router.endEnumeratlon THEN LOOP; --don't print empties 
WrlteStr1ng["Networks "L]; 

WriteLongNumber[LONG[hop]]; 

WriteString[" hops away = {"Lj; 

UNTIL net = Router.endEnumeration DO 

ExtendedStrIng.AppendNumber[@net. SIZE[System.NetworkNumber], 8. string]; 
WriteString[str1ng] ; string. 1 ength «• 0; WriteChar[ ’B] ; 
net «- Router.EnumerateRoutingTable[net, hop]; 

IF net ¥ Router.endEnumeration THEN WriteString[". "L]; 

ENDLOOP; 

Wr1teChar['}]; 

NewL1ne[]; 

ENDLOOP; 

Router.Fi11Rout1ngTable[0]; --shut down the table 
END; —PrintLocalRoutlngTable 

PrIntNSAddress: PROC [a: POINTER TO System.NetworkAddress] 3 
8EGIN 

buffer: STRING <- [50]; 

ExtendedString.AppendNumber[@a.net, SIZE[System.NetworkNumber], 8. buffer]; 
buf fer[buffer. 1 ength] <- buffer. length *■ buffer. length + 1; 

ExtendedString.AppendNumber[@a.host, SIZE[System.HostNumber]. 8. buffer]; 
buf fer[buffer. 1 ength] <- buffer. length «- buffer, length + 1; 

ExtendedString.AppendNumber[@a.socket, SIZE[System.SocketNumber], 8, buffer]; 
Wr1teString[buffer]; 

END; 

echoName: LONG STRING *■ NIL; 

Commands: PROC [index: CARDINAL] = { 

SELECT Index FROM 
0 => { 

MyNameIs[ 

myNamels: "Echo User"L, 
myHelpIs: "Echo user"L]; 

EchoUser[]}; 

1 => { 

MyNameIs[ 

myNamels: "Routing Tables"L. 

myHelpIs: "Show NS network routing tables"L]; 

PrintLocalRoutingTable[]}; 
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ENOCASE => IndexTooLarge}; 


commandProcessor; CommandProcessor *■ [Commands]; 
-- Initialization 

RegisterCommandProc[@commandProcessor]; 

END. 
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Copyright (C) 1981, 1982, 1983, 1984 . 1985 by Xerox Corporation. All rights reserved. 


-- This file is the command Processor. 


DIRECTORY 

File USING [Error, ErrorType, Unknown], 

Format USING [HostNumber, StringProc], 

Frame USING [Free, ReadLocalWord], 

Heap USING [systemZone], 

Inline USING [BITNOT, HlghHalf, LowHalf], 

OthelloDefs, 

Othelloops USING [ 

GetTImeFromTImeServer, IsTImeValid, 

SetProcessorTIme, TimeServerError], 

OthelloToolDefs USING [tty], 

PhysicalVolume USING [Error, ErrorType, NeedsScavenging], 

Pi 1otCllent USING [], 

PrincOps USING [frameSIzeMap, LocalFrameHandle. LocalOverhead], 

Process USING [Pause, SecondsToTIcks], 

Runtime USING [GetBcdTIme, IsBound], 

SpecialRuntime USING [GetCurrentSIgnal], 

SpecialSpace USING [realMemorySize], 

SpeclalSystem USING [GetProcessorlD], 

Scavenger USING [Error,. ErrorType], 

String USING [ 

AppendChar, AppendCharAndGrow, AppendDecimal, AppendLongNumber, 
Equivalentsubstring, InvalIdNumber, StrlngBoundsFault, StringToNumber, 

SubStrlngDescriptor, Uppercase], 

System USING [ 

GetGreenwichMeanTime, GreenwIchMeanTIme, gmtEpoch, 

LocalTImeParameters, GetLocalTimeParameters, SetLocalTImeParameters], 

TTY USING [ 

B1InkDIsplay, CharsAvai1able, GetChar, Handle, 

PutChar, PutString, RemoveCharacter, ResetUserAbort, UserAbort], 

Time USING [ 

Append, defaultTime, Invalid, Pack, Unpack, Unpacked, useGMT, useSystem], 
UserTerminal USING [ 

CursorArray, GetCursorPattern, SetCursorPattern], 

Version USING [Append], 

VerslonExtras USING [AppendCopyrlght], 

Volume USING [ 

InsufficIentSpace , NeedsScavenging, NotOpen, Readonly, Unknown], 

VolumeConverslon USING [Error, ErrorType]; 

Util 1tyPilOtClientlmpl: PROGRAM 
IMPORTS 

File, Format, Frame, Heap, Inline, OthelloDefs, OtheiloOps, OthelloToolDefs, 
Physical Volume, Process, Runtime, SpecialRuntime, SpecialSpace, SpeclalSystem, 
Scavenger, String, System, Time, TTY, UserTerminal, 

Version, VersionExtras, Volume, VolumeConversion 
EXPORTS OthelloDefs, OthelloToolDefs = 

BEGIN 

MyNamels: PUBLIC SIGNAL [ 

myNamels: LONG STRING, myHelpIs: LONG STRING] = CODE; 

AbortingCommand: PUBLIC ERROR [ 

reason: LONG STRING, reasonOne: LONG STRING «■ NIL] = CODE; 


IndexTooLarge : PUBLIC ERROR = 

CODE; 

Question: 

PUBLIC SIGNAL = 

CODE; 

T ryAgain: 

PUBLIC SIGNAL = 

CODE; 

BS: 

CHARACTER 

= 

IOC; 



ControlA: 

CHARACTER 

= 

'A - 

100B; 


ControlP: 

CHARACTER 

= 

' P - 

100B: 


ControlW: 

CHARACTER 

= 

•w - 

100B: 


CR: 

CHARACTER 

= 

15C ; 



DEL: 

CHARACTER 

= 

177C 



ESC: 

CHARACTER 

S 

33C; 



SP: 

CHARACTER 

= 

' ; 



NUL: 

CHARACTER 

= 

OC; 




CommandProcessor: TYPE = OthelloDefs.CommandProcessor; 


-- Commands 


CurrentComand: SIGNAL RETURNS [ 

proc: PROC [index: CARDINAL], index: CARDINAL] = CODE; 

ForAllCommandProcs: PROC [P: PROC[LONG STRING]] = { 

FOR c: LONG POINTER TO CommandProcessor «■ commands, c.next WHILE c # NIL DO 
FOR 1; CARDINAL IN [0..LAST[CARDINAL]) DO 
ENABLE CurrentComand => RESUME[c.proc, i]; 
c.proc[i 

! MyNamels => {P[niyNameI s]; CONTINUE); 

IndexTooLarge => EXIT]; 

ENDLOOP ENDLOOP); 

Help: PROC = { 
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WldthProc: PROC [s: LONG STRING] = {tabWIdth *• MAX[tabWidth. s. length]}; 
tabwidth: CARDINAL «- 0 ; 

SIGNAL MyNafneIs[myNameIs: "Help"L, myHelpIs: "Type this table"L]; 

ForAllCommandProcs[WidthProc]; 
tabwidth «■ tabwidth + 4; 

FOR c: LONG POINTER TO CommandProcessor «- commands, c.next WHILE c ft NIL DO 
FOR 1: CARDINAL IN [0..LAST[CARDINAL]) DO 
c.proc[1 
! MyNamels => { 

WriteStringfmyNamels]; 

THROUGH [myNamels.length..tabWidth) DO WriteChar[' ] ENDLOOP; 
WrlteLine[myHe1pIs]; 

CONTINUE}; 

IndexTooLarge => EXIT]: 

ENDLOOP ENDLOOP; 

WriteLine[ 

"In General, Del will abort current command, ? will explain options'^]}; 

TimeUser: PROC [index: CARDINAL] = { 

SELECT Index FROM 
0 => { 

SIGNAL MyNameIs[myNameIs: "Time"L, myHelpIs: "Time of day"L]; 

WriteString["Current t1me"L]; WriteT1me[Tlme.defaultTime, TRUE]}; 

1 => 

Help[]; 

ENDCASE => 

ERROR IndexTooLarge}; 

RegisterCommandProc: PUBLIC PROC [ 

commandProc: LONG POINTER TO CommandProcessor] = { 
commandProc.next <- commands: commands «■ commandProc}; 

commands: LONG POINTER TO CommandProcessor «- OhelpCommandProcessor; 
helpCommandProcessor: CommandProcessor <- [TimeUser, NIL]; 


Basic command processing 

CollectCommand: PROC RETURNS [ 

p: PROC [index: CARDINAL], index: CARDINAL] = { 

ExplainOptions: PROC = { 
first: BOOLEAN <- TRUE: 

WriteChar[ 1 ?]; 

IF userStr i ng . 1 ength ft 0 THEN ( 

P: PROC [s: LONG STRING] = { 

IF HeadMatch[s, userString.length] THEN { 

WriteString[IF first THEN "\rCurrent Options Are: "L ELSE ", "L]; 

Wr1teStr1ng[s]; first «■ FALSE}}; 

ForAl1CommandProcs[P]}; 

IF first THEN { -- Didn’t match,., tell all 

P: PROC [s: LONG STRING] = ( 

IF -first THEN WriteStr1ng[", "LJ; Wr1teStr1ng[s]; first <- FALSE}; 
Wr1teString["\rValId Commands Are: ”L]; 

ForAl!CommandProcs[P]}; 

WriteString["\r> ”L]; Wr1teStr1ng[userString]}; 

FlndAnswer: TYPE = RECORD [ 

SELECT how: + FROM none => NULL, many => NULL, 

one => [proc: PROC [Index: CARDINAL], index: CARDINAL], 

ENDCASE]; 

FindPossibles: PROC RETURNS [ans: FindAnswer «• [none[]]] = { 

P: PROC [matchstring: LONG STRING] = [ 

IF HeadMatch[matchString, head] THEN 
WITH ans SELECT FROM 
none => { 

ans «- [one[CurrentComand[] .proc , CurrentComand[] . index]] ; 

UNTIL userString.length = matchstring.length DO 

userSt ring [userString .length] <- matchStri ng[userString .length] ; 

IF (userString. length «- userString. 1 ength + 1) = userString .maxlength THEN [ 
WriteLine[" Command too long!"L]; ERROR TryAgain} 

ENDLOOP}; 

ENDCASE => { 

—ASSERT[head#0] 

FOR i : CARDINAL IN [head - 1..LAST[CARDINAL]) DO 

IF LowerCase[userString[i]] ft LowerCa$e[matchString[i]] THEN { 
userStri ng , 1 ength <- i; EXIT}; 

ENDLOOP: 

ans <- [many[]]}}; 

head: CARDINAL <- userString . length ; 

IF head = 0 THEN RETURN; 

ForAl1CommandProcs[P]; 

WHILE head ft userStr1ng.1ength DO 

Wr1teChar[userStr1ng[head]]; head «■ head + 1 ENDLOOP}: 

HeadMatch: PROC [matchstring: LONG STRING, head; CARDINAL] 

RETURNS [BOOLEAN] = { 

IF head > matchstring.1ength THEN RETURN[FALSE]; 

FOR 1: CARDINAL IN [0..head) DO 

IF LowerCase[userString[i]] ft LowerCase[matchString[i]] THEN 
RETURN[FALSE] 

ENDLOOP; 

RETURN[TRUE]}; 

LowerCase: PROC [c: CHARACTER] RETURNS [CHARACTER] = { 

RETURN[IF c IN [’A..’Z] THEN c + ('a - 'A) ELSE c]}; 

userString: STRING = [100]; 

userString . 1 ength «- 0; 

WriteStrlng["> ”L]; 
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DO 

c: CHARACTER = ReadChar[]; 

SELECT c FROM 

DEL => {Writeline[" XXX"L]; ERROR TryAgaln}; 

BS, ControlA => IF userStrlng,1ength # 0 THEN 

EraseTTYChar[userStr1ng[userString. length «- userString.1ength - 1]]; 

ControlW => 

IF userStrlng.length # 0 THEN DO 

EraseTTYChar[userStr1ng[userStr1ng. length «* userStrlng , 1 ength - 1]]; 

IF userStrlng.1ength=0 OR userString[userStr1ng.length - 1j = SP THEN EXIT 
ENDLOOP; 

’? => Expla1n0ptions[]; 

CR, SP => { 

ans: FindAnswer = FlndPossIbles[]; 

WITH theAns: ans SELECT FROM 
none => { 

IF Runtime.IsBound[LOOPHOLE[OthelIoDefs.A1ternateGetCMFile]] 

AND userStrlng.length > 1 AND userString[0] = '0 THEN { 

NewLine[]; 

Othel1oDefs.A1ternateGetCMFi!e[userString 
! OthelloDefs.MyNamels 3 > RESUME]; 

ERROR TryAgaln}; 

IF prometheusBound THEN Abort1ngCommand["Scr1pt Error"L] 

ELSE B11nkD1splay[]}; 
many => NULL; 

one => RETURN[theAns.proc, theAns.Index]; 

ENDCASE => ERROR}; 

ENDCASE 3 > 

IF (userStrlng. length *■ userStrlng. length + 1) = userString.maxlength THEN { 
WriteL1ne[" Command too long!"L]; ERROR TryAgain} 

ELSE WriteChar[userStr1ng[userStr1ng.length - 1] «- c]; 

ENDLOOP}; 


Utility-Type Functions 


Confirm; PUBLIC PROC [how: Othel loDef s .Confi rmType «- once] = [ 

IF CommandF11eActive[] THEN RETURN; 

Wr1teStr1ng["Are you "L]; 

IF how a thrice THEN Wr1teString["sti11 "L]; 

Wr1teString[”sure? [y or n]; "L]; 

DO 

c: CHARACTER = ReadChar[]; 

SELECT c FROM 

'y, 'Y, CR => {WriteL1na["Yes"L]; EXIT}; 

'n, 'N, DEL => (WriteLine["No"L]; ERROR TryAgain}; 

ENDCASE => B11nkD1splay[]; 

ENDLOOP; 

IF how = twice THEN { 

Process.Pause[Process.SecondsToT1cks[3]]; Flushlnput[]; Confirm[thrice]}}; 

DebugAsk: PUBLIC PROC = { 

Wr1teString["\rType ControlP to muddle on."L]; 

WHILE ReadChar[] ft ControlP DO ENDLOOP; NewL1ne[]}; 

spacesInStrlngOK: BOOLEAN «- FALSE; 

GetName: PUBLIC PROC [ 

prompt: LONG STRING «- NIL, dest; LONG POINTER TO LONG STRING, 

how: Othel!oDefs.EchoNoEcho +■ echo, signalQuestion: BOOLEAN «- FALSE] = 

BEGIN 

first: BOOLEAN ♦- TRUE; 

EraseChar: PROC = { 

IF dest.length = 0 THEN RETURN; 
dest.length «• dest.length - 1; 

EraseTTYChar[IF how = echo THEN dest[dest.length] ELSE ’*]; 

IF dest.length = 0 AND dest.maxlength > 20 THEN { 

Heap.systemZone.FREE[dest]; dest* «- Heap.systemZone.NEW[StringBody[10]]}}; 

CWriteC: PROC [c: CHARACTER] s {WriteChar[IF how = echo THEN c ELSE ’*]}; 

CWrlteString: PROC 3 { 

FOR i: CARDINAL IN [0. .dest.length) DO CWr1teC[dest[1]] ENDLOOP}; 

IF dest* = NIL THEN dest* *■ Heap. systemZone . NEW[StringBody[ 10]] ; 

WriteString[prompt]; CWriteString[]; 

DO 

c: CHARACTER 3 ReadChar[]; 

SELECT TRUE FROM 

c 3 BS, c = ControlA => EraseChar[]; 

<< (c = SP AND ~spacesInStr1ngOK),>> c 3 CR => fNewLine[]; RETURN}; 
c 3 DEL => (Wr1teL1ne[" XXX"L]; ERROR TryAgain}; 
c = ControlW => 

00 

EraseCharf]; 

IF dest.1ength=0 THEN EXIT; 

SELECT dest[dest.length-1] FROM 

IN [’a . .'z], IN ['A. . 'Z], IN ['0..*9] => LOOP; 

ENDCASE => EXIT; 

ENDLOOP; 

c = '? AND signalQuestion => { 

SIGNAL Question; WriteString[prompt]; CWriteString[]; LOOP}; 
c >= SP => { 

IF first THEN WHILE dest. length/00 DO EraseChar[] ENDLOOP; 

String.AppendCharAndGrow[dest, c. Heap.systemZone]; CWriteC[dest[dest.length-1]]} 
ENDCASE 3 > 81inkDisplay[]; 
first <■ FALSE; 

ENDLOOP: 

END; 
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numberstring: LONG STRING *• NIL; 

RaadNumber: PUBLIC PROC [ 

prompt: LONG STRING, min, max, default: LONG CARDINAL *■ LAST[LONG CARDINAL]] 
RETURNS [ans: LONG CARDINAL] = { 

DO 

IF default # LAST[LONG CARDINAL] THEN [ 

IF numberString = NIL THEN numberStrlng *■ Heap . systemZone .NEW[StringBody[ 15]] ; 
numberstring, length «* 0; String .AppendLongNumber[numberstring , default, 10]}; 
WriteString[prompt]; WriteChar['[]; WriteLongNumber[m1n]; 

WriteString[".."L]; WriteLongNumber[max]; WriteString["]: "L]; 

GetName[de$t: OnumberString]; 
ans «■ 0; 

FOR i: CARDINAL IN [0..numberstring,length) DO 
IF numberString[1] NOT IN ['0,.’9] THEN EXIT; 
ans «* I0*ans + numberString[i] - '0; 

REPEAT FINISHED => IF ans IN [min..max] THEN { 

Heap.systemZone.FREE[@numberString]; RETURN}; 

ENDLOOP; 

Wr1teL1ne["Bad Number !"L]; 

ENDLOOP}; 

ReadShortNumber: PUBLIC PROC [ 

prompt: LONG STRING, min, max, default: LONG CARDINAL] 

RETURNS [CARDINAL] = { 

RETURN[Inline.LowHalf[ 

ReadNumber[prompt, min, MIN[max, LONG[LAST[CARDINAL]]], default]]]}; 

WriteFixedWIdthNumber: PUBLIC PROC [ 

x: LONG CARDINAL, count: CARDINAL, base: CARDINAL * 10] = { 

WFD: PROC [x: LONG CARDINAL, c: CARDINAL] = { 

IF c = count THEN RETURN; 

WFD[x/base, c + l]; 

WriteChar[IF c = 0 OR x ft 0 THEN Ini ine. Lov/Hal f[x MOD base] + ‘0 ELSE ’ ]}; 
WFD[x, 0]}; 

WrlteLongNumber: PUBLIC PROC [num: LONG CARDINAL] = { 
s: STRING <- [40]; 
s.length *• 0; 

String.AppendLongNumber[s, num, 10]: 

WriteStr1ng[s]}; 

WriteOetal: PUBLIC PROC [num: CARDINAL] = { 

IF num 0 0 THEN Write0ctal[num/8]; WriteCfoar[(num MOD 8) + '0]}; 

Yes: PUBLIC PROC [s: LONG STRING] RETURNS [BOOLEAN] = { 

WriteStr1ng[s]; 

DO 

SELECT ReadChar[] FROM 

'Y, 'y, CR => (WriteLine["yes"L]; RETURN[TRUE]}; 

'N, 'n, DEL => (WriteLine["no"L]; RETURN[FALSE]}; 

ENOCASE => WriteChar['?]; 

ENDLOOP}; 


Time munging 


— string format must be; bDD-MMM-YYbbHH;MM:SSbbZZTb 
PackedTimeFromString: PUBLIC PROC [ 
s: LONG STRING, justDate: BOOLEAN] 

RETURNS [t: System.GreenwichMeanTime] = { 

Empty: PROC [s: LONG STRING] RETURNS [BOOLEAN] = { 

RETURN[s = NIL OR s.length = 0]}; 

EquivalentChar; PUBLIC PROC [cl, c2: CHARACTER] RETURNS [BOOLEAN] - { 
RETURN[String,UpperCase[cl] = String.UpperCase[c2]]}; 

GetToken: PROC [storage: LONG STRING, s: LONG STRING, c: CARDINAL] 
RETURNS [is: CARDINAL] = { 

FOR is <- c. is •- 1 UNTIL is >= s.length DO 
ch: CHARACTER = s[is]; 

SELECT ch FROM 

IN ['a..'z], IN ['A..*Z], IN ['0,.’9] => 

String.AppendChar[storage, ch]; 

'- => EXIT; -- terminator 

1 => IF ~Empty[storage] THEN EXIT; --terminating blank 

ENDCASE; 

ENDLOOP; 

RETURN[1s + 1]}; 

Dolt: PROC [$: LONG STRING] RETURNS [t: System.GreenwichMeanTime] = { 
Get: PROC RETURNS [CARDINAL] = ( 

si. length 0; nextChar <- GetToken[sl, s, nextChar]; 

RETURN[sl.length]}; 

GetNumber: PROC RETURNS [CARDINAL] = { 

[] <- Get[] ; RETURN[Stri ng . Stri ngToNumber[s 1, 10]]}; 
m: String . SubStringDescriptor *■ [ 

base: "JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC’L, 

offset: NULL, length: 3]: 
si: STRING = [3]; 

month: Stri ng . SubStringDescriptor «• [ 
base: si, offset: 0, length: NULL]; 
time: Time .Unpacked *• [ 

0, 0, 0, 0, 0, 0, 0, FALSE, System.GetLocalT1meParameters[]]; 
nextChar: CARDINAL «- 0; 
packlt: BOOLEAN TRUE; 

IF Empty[s] THEN RETURN[System,gmtEpoch]; 
time.day «- GetNumber[]; 
month. length *■ Get[]; 
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FOR 1: CARDINAL IN [0..12) DO 
m.offset «- i*3; 

IF String. EquivalentSubString[@month, @m] THEN { 
time.month «- i; EXIT}; 

ENDLOOP; 

time.year <- GetNumber[]; 

time.year «■ time.year + (IF time.year>68 THEN 1900 ELSE 2000); 

IF justDate THEN { 

time.hour <- 23; time.minute +• 59; time.second «- 59} 

ELSE { 

time, hour «- GetNumber[] ; 
time.minute <■ GetNumber[]; 
time.second <- GetNumber[]; 

IF Get[] ff 0 THEN { 

zones: PACKED ARRAY [5..8] OF CHARACTER = [*E, 'C, 'M, ’P]; 

FOR i: CARDINAL IN [5..8] DO 

IF Equ1valentChar[sl[0], zones[i]] THEN {time.zone. zone *■ i; EXIT} 

REPEAT FINISHED => time . zone. zone «* 0; -- GMT 

ENDLOOP; 

tlme.dst +■ Equ1vaIentChar[sl[l]. ’D]; 
packlt *• FALSE}}; 
t <- Time. Pack[time , packlt]}; 
t <* DoIt[s 

! String.InvalidNumber, String.StringBoundsFault, Time.Invalid => { 
t «■ System.gmtEpoch; CONTINUE}]}; 

WriteTime: PROC [ 

t: System.GreenwichMeanTime, showDay: BOOLEAN «• TRUE, 
type: {system, gmt, pacific} *■ system] = { 
days: ARRAY [0..7) OF STRING = [ 

"Monday"L, "Tuesday"L, "Wednesday"L, "Thursday"L, 

"Friday"L, "Saturday"L, "Sunday"L]; 
temps: STRING = [40]; 

Time.Append[temps. 

Time.Unpack[t. SELECT type FROM 

pacific -> [useThese[[west, 8, 0, 121. 305]]], 
gmt => Time.useGMT, 

ENDCASE => Time.useSystem]]; 

IF showDay THEN { 

WriteChar[’ ]; WriteString[days[Time.Unpackft].unpacked,weekday]]}; 

IF temps[0] » ' THEN WriteCharf ]; 

WriteLine[temps]}; 


-- The Big Loop 
prometheusBound: BOOLEAN = 

Runtime.IsBound[LOOPHOLE[OthelloDefs.GetCannedScript]]; 

Run: PUBLIC PROC = 

BEGIN 

ENABLE ABORTED => CONTINUE; -- when deactivated 
ttyHandle «■ OthelloToolDefs.tty; 

ResetAbort[]; 

PrlntHeral d[j; 

PrintPIDs[]; 

PrintMemorySize[]; 

GetTime[]; 

DO 

Tel 1 Error: PROC [s: LONG STRING] * { 

IF prometheusBound THEN OthelloOefs.ThereIsAnError[]; 
commandlndex <- LAST[CARDINAL]; NewLine[]; WriteString[s]}; 
p: PROC [index: CARDINAL]; i: CARDINAL; 

IF (~CommandFileActive[]) AND prometheusBound THEN { 

ResetAbortf]; OthelloDefs.GetCannedScript[]} ; 

IF CommandF11eActive[] THEN 
CheckUserAbort[ 

IMyAborted => [Tel 1Error["Command File Aborted\r"L]; LOOP}] 

ELSE ResetAbort[]; 

[p, i] <- Col 1ectCommand[ 

! TryAgain => RETRY; 

AbortingCommand => {TellError[reason]; WriteLine[reasonOne]; LOOP}; 
MyAborted => {Tel 1Error["Command File Aborted\r"L]; LOOP}]; 

NewLine{]; 
p[i ! 

MyNamels => RESUME; 

MyAborted => {Tel 1Error["ABORTED\r"L]; CONTINUE}; 

AbortingCommand => { 

Tel 1Error[reason]; WriteLine[reasonOne]; CONTINUE}; 

File.Unknown => { 

Tel 1 Error["F11e ,Unknown‘'L] ; DebugAsk[]; CONTINUE}; 

File.Error => { 

PrintNames: PROC [x: File.ErrorType] = { 
e: ARRAY File.ErrorType OF STRING = [ 
invalidParameters: "invalidParameters"L , 
reservedType: "reservedType"L]; 

WriteString[e[x]]}; 

Tel 1Error["File.£rror["L]; 

PrintNames[type]; 

WriteChar[']]; 

DebugAsk[]; 

CONTINUE}; 

PhysIcalVolume.Error => { 

PrintNames: PROC [x: PhysicalVolume.ErrorType] = { 
e: ARRAY PhysicalVolume.ErrorType OF STRING 3 [ 
badDisk: "badOisk"L, 
badSpotTableFul1; "badSpotTableFul1”L, 
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containsOpenVolumes: "conta1nsOpenVolumes"L, 
dlskReadError: "diskReadError"L, 
hardwareError: "hardwareError"L, 
hasPi 1otVolume: "hasPi1otVolume"L, 
alreadyAsserted: "alreadyAs$erted"L, 
insuffIcientSpace: "insufficientSpace"L, 
invalidHandle: "invalidHandle"L, 
nameRequired: "nameRequired"L, 
needsConversion: "needsConversioiV'L, 
notReady: ”notReady"L, 
noSuchDrive: "noSuchOrive"L, 
noSuchLogicalVolume: "noSuchLoglcalVolume"L, 
physical Vo 1 umeUn known: "phy$1ca1VolumeUnknown"L, 
writeProtected: "writeProtected"L, 
wrongFormat: "wrongFormat"L] ; 

WriteString[e[x]]}: 

TellError["PhysicalVolume.Error["L]; PrintNames[error]; 

WriteChar[']]; 

DebugA$k[]; 

CONTINUE}; 

Physical Volume.NeedsScavenging -> { 

Tel 1Error["PhysicalVolume.NeedsScavenging"L]; 

DebugAsk[]; CONTINUE}; 

Scavenger.Error =>{ 

PrlntNames: PROC [x: Scavenger.ErrorType] = { 
e: ARRAY Scavenger.ErrorType OF STRING = [ 
cannotWriteLog : "cannotWriteLog ,, L. 
noSuchPage: ''noSuchPage"L, 
orphanNotFound : "orphanNo tFound"L, 
volumeOpen: "volumeOpen"L, 
diskHardwareError: "d1SkHardwareError"L, 
dlskNotReady: "diskNotReady"L, 
needsConversion: "needsConversion"L, 
needsRiskyRepair: "needsRiskyRepair"L]; 

WriteString[e[x]]}; 

TellError["Scavenger.Error["L]; PrintNames[error]; WriteChar[']]; 

DebugAsk[]; 

CONTINUE}; 

VolumeConverslon.Error =>{ 

PrlntNames: PROC [x: VolumeConversion.ErrorType] a { 
e: ARRAY VolumeConversion.ErrorType OF STRING = [ 
hardwareBroken: "hardwareBroken"L, 
lOStLog: "lostLog"L, 

runPreviousScavenger: "runPrevlousScavenger"L. 
volumeVersionTooNew: "volumeVersionTooNew"L, 
volumeVerslonTooOld: "vo1umeVers1onToo01d"L]; 

WriteString[e[x]]}; 

Tel 1Error["VolumeConversion.Error["L]; PrintNames[error]; WriteChar[']]; 

DebugAsk[]; 

CONTINUE}; 

Volume.InsuffIcientSpace s > [ 

TellError["Volume.InsuffIcientSpace"L]; 

DebugAsk[]; CONTINUE}; 

Volume.NotOpen => { 

TellError["Volume.NotOpen"L]; OebugAsk[]; CONTINUE}; 

Volume.NeedsScavenging => { 

Tel 1Error["Please Scavenge the volume first"L]; CONTINUE}; 

Volume.Unknown => { 

TellError["Volume.Unknown"L]; DebugAsk[]; CONTINUE}; 

Volume.Readonly => { 

TenError["Volume . ReadOnly"L] ; DebugAsk[]; CONTINUE}; 

String.StringBoundsFault => ( 

Tel 1Error["String.StringBoundsFault"L]; DebugAsk[]; CONTINUE); 

TryAgain => CONTINUE; 

ABORTED => REJECT; 

ANY => { 

Signal: SIGNAL; 

args: PrincOps.LocalF rameHandle; 

TellError["Uncaught Signal = C"Lj; 

[signal: signal, signalArgs: args] «- 

SIGNAL SpecialRuntime.GetCurrentSignal; 

WriteOctal[Inline.LowHalf[LOOPHOLE[signal]]]; 

WriteChar[’,]; 

WriteOctal[Iniine.HighHalf[LOOPHOLE[signal]]]; 

WriteChar[']]; 

IF args # NIL THEN { 

size: CARDINAL «■ PrincOps .frameSizeMap[Frame .ReadLocalWord[args] .fsi ] 

- SIZE[Pr1ncOps.LocalOverhead]; 

Wr1teString[", msg = ["L]; 

FOR 1: CARDINAL IN [0..size-1) DO 
WriteOctal[args[i]]; WriteString[”, "L] ENDLOOP; 
WriteOctal[args[size~I]]; WriteChar[']]; 

Frame.Free[args]}; 

DebugAsk[]; CONTINUE}]; 

ENDLOOP; 

END; 


TTY Interface Stuff 


useADM: BOOLEAN = FALSE; 

ttyHandle: TTY.Handle <- Othel 1 oToolDefs.tty; 

B1inkDisp1 ay: PUBLIC PROC = (TTY.B1inkDIsplay[ttyHandle]}; 
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MyAborted: ERROR * CODE; 


CheckUserAbort: PUBLIC PROC = { 

IF TTY.UserAbort[ttyHandle] THEN {ResetAbort[]; ERROR MyAborted}}; 
EraseTTYChar: PROC [c: CHARACTER! « { 

SELECT c FROM IN [' ..'-] => NULL; CR => RETURN; ENDCASE => Era$eTTYChar[' ]; 
TTY.RemoveCharacter[ttyHandle];}; 

ReadChar: PUBLIC PROC RETURNS [c: CHARACTER] = { 
gotlt: BOOLEAN; 

[gotlt, c] <■ GetCommandFHoCharacter[]; 

IF gotlt THEN RETURN; 

RF:TURN[TTY.GetChar[ ttyHandl e]]}; 

SetCursor: PUBLIC PROC [c: OthelloDefs.Cursor] = { 

cursor: ARRAY OthelloDefs.Cursor OF UserTerminal.CursorArray = [ 
pointer: [ 

100000B, 140000B, 1600008, 170000B. 174000B, 176000B, 177000B, 170000B, 

154000B, 114000B, 006000B, 006000B, 003000B, 003000B, 00I400B, 00L400B], 

ftp: [ 

000177B, 076077B, 0400378. 040017B, 070007B, 043703B, 040401B, 040400B, 

000400B, 100436B, 140421B, 160421B, I70036B, 174020B, 176020B. 177020B]]; 

IF -useADM THEN UserTerminal.SetCursorPattern[cursor[c]]; 
cursorFlIpped <* FALSE}; 

cursorFlipped: BOOLEAN; 

FIIpCursor: PUBLIC PROC = { 

IF -useADM THEN { 

c: UserTermlnal .CursorArray +■ UserTermi nal ,GetCursorPattern[]; 

FOR i: CARDINAL IN [0..LENGTH[c]) DO c[i] «• Iniine.BITNOT[c[i]] ENDLOOP; 
UserTermlnal.SetCursorPattern[c]} 

ELSE { 

IF cursorFlIpped THEN WriteChar[BS] ELSE WriteChar[SP]; 
cursorFl ipped <- -cursorFl ipped}}; 

Flushlnput: PROC = { 

UNTIL TTY.CharsAvailable[ttyHandle] = 0 DO 
[] <- TTY.GetCharfttyHandle] ENDLOOP}; 

NewLine: PUBLIC PROC = {WriteChar[CR]}; 

ResetAbort: PROC = {TTY.ResetUserAbort[ttyHandle]}; 

WrlteChar: PUBLIC PROC [c: CHARACTER] = { 

IF prometheusBound AND OthelloDefs.SuppressOutput[] THEN RETURN; 
TTY.PutChar[ttyHandle, c]}; 

WriteLine: PUBLIC PROC [s: LONG STRING] = {WriteString[s]; NewLine[]}; 

WriteString: PUBLIC PROC [s: LONG STRING] - { 

IF prometheusBound AND OthelloDefs.SuppressOutput[] THEN RETURN; 

IF s ft NIL THEN TTY.PutString[ttyHandle. s]}; 

command: LONG STRING <- NIL; 

commandlndex: CARDINAL «- 0: 

CommandFileActive: PROC RETURNS [BOOLEAN] = INLINE {RETURN[command#NIL]}; 

GotCommandFileCharacter: PROC RETURNS [ 
isThere: BOOLEAN, c: CHARACTER] = INLINE { 

IF command ft NIL THEN { 

IF contmandlndex >= command.Iength THEN { 

Heap.systemZone.FREE[@command]; command *■ NIL} 

ELSE { 

commandlndex «■ commandlndex + 1; 

RETURN[TRUE, comrnand[commandIndex-l]]}}; 

RETURN[FALSE, OC]}; 

SetCommandString: PUBLIC PROC [s: LONG STRING] = { 

IF command ft NIL THEN Heap.systemZone.FREE[@command]; 
command +• s; commandlndex *• 0}; 


Initialization Stuff 

GetTime: PROC = { 

tinieTrys: CARDINAL «■ 3; 

time: System.GreenwIchMeanTime; 

LTPs: System.LocalTimeParameters; 

timeFromServer: BOOLEAN *- TRUE; 
getTimeStri ng : LONG STRING «■ NIL; 

[time, LTPs] Othel 1 aOps .GetTimeFromTimeServer[ 

! Othelloops.TimeServerError => IF error=noResponse THEN { 

IF (timeTrys «■ timeTrys-l) 3 0 THEN {timeFromServer <- FALSE; CONTINUE} 

ELSE {IF timeTrys=2 THEN WriteString["Locat1ng Time Server..."L]; RETRY}} 
ELSE IF error=noCommunicat1onFac11ities THEN { 

WriteLine["not Communication Facilities to find time"L]; 
timeFromServer «■ FALSE; CONTINUE} 

ELSE ERROR]; 

IF timeFromServer THEN { 

IF timeTrys#3 THEN WriteLine["success ,, L] ; 

System,SetLocalTimeParameters[LTPs]; 

OthelloOps.SetProcessorTime[time]; 

RETURN}; 
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WrlteLine["fal1ed.\rPlease enter time information (type ? for help)"L]: 
getTImeString <- Heap.systemZone .NEW[Str 1 ngBody[ 10]] ; 

LTPs *■ GetT1meZoneFromUser[@getTimeString ! TryAgain => RETRY]; 

System,SetlocalT1meParameters[LTPs] ; 
spacesInStririgOK «- TRUE; 

GetT1meFromUser[@getT1meString ! TryAgain => RETRY]; 
spacesInStririgOK *■ FALSE; 

Heap.systemZone.FREE[0getTimeString]}; 

GetTimeFromUser; PROC [p; LONG POINTER TO LONG STRING] = { 

tlmePrompt: STRING = "Please Enter the date and 24 hour time in form 
DD-MMM-YY HH:MM:SS 
Time: "L; 

IF OthelloOps.IsTimeVa1id[] THEN { 

WriteString["Current time "L]; WriteTime[System.GetGreenwichMeanTime[]]; 
IF ~Yes["0o you wish to change the time?: "L] THEN RETURN); 

IF p#NIL THEN p.length «- 0; 

DO 

time: System.GreenwichMeanTIme; 

GetName[timePrompt, p]; 

time *■ PackedTimeFromString[pt, FALSE]; 

IF time=System.gmtEpoch THEN { 

WriteLine["Inva1id date/time -- please try again."L]; LOOP); 
WriteString["Set time to"L]; WriteTime[time]; 

IF Yes["Okay?: "L] THEN { 

OthelloOps.SetProcessorT1me[time]; EXIT} 

ELSE LOOP 
ENDLOOP); 


GetTimeZoneFromUser; PROC [string: LONG POINTER TO LONG STRING] 
RETURNS [Itp: System.LocalTimeParameters] = { 

GetNum: PROC [ 

prompt: STRING, min, max, default; INTEGER] 

RETURNS [ans: INTEGER] = [ 
string.length «• 0 ; 

String.AppendOecimal[stringt, default]; 

DO 


isNeg: BOOLEAN <- FALSE; 

Writestring[prompt]; 

Wr1teChar['[]; IF ans<0 THEN WriteChar[’-]; WriteLongNumber[ABS[min]]; 
WriteStr1ng[" ..”L]; WriteLongNumber[max]; WriteString["]: "L]; 
GetName[dest: string, signalQuestion: TRUE]; 
ans <- 0; 

FOR 1: CARDINAL IN [0..string.1ength) DO 

IF i =0 AND string[ i]=' - THEN {IsNeg <- TRUE; LOOP): 

IF string[i] NOT IN [’0..’9] THEN EXIT; 
ans <- 10*ans + string[1] - '0; 

REPEAT FINISHED => { 

IF isNeg THEN ans <- -ans; IF ans IN [min..max] THEN RETURN); 
ENDLOOP; 

WriteL1ne["Bad Number !"L] ; 

ENDLOOP); 

dstSplel: STRING = " 

The ""First day of DST"" is the day of the year on or before which 
Daylight Savings Time takes effect, where: 

1 => January 1 
366 => December 31. 

(The correspondence between numbers and days is based on a leap 
year. Similarly, ""Last day of DST"" is the day of the year on or 
before which Daylight Savings Time ends, Note that in any given 
year. Daylight Savings Time actually begins and ends at 2 AM on 
the last Sunday not following the specified date. The system 
makes this adjustment for you automatically. The normal values 
are 


121 (April 30) for the first day of DST 
305 (October 31) for the last day of DST. 

If Daylight Savings Time Is not observed locally, both values 
should be set to zero."L; 

ZoneSpiel: STRING = " 

Number of hours between Greenwich and local time. For time 
zones west of Greenwich, the offset is negative; for time zones 
east of Greenwich, the offset is positive. Examples: 


San Francisco 
Denver 
Chicago 
Boston 
; INTEGER; 


-8 hours 
-7 hours 
-6 hours 
-5 hours 


(Pacific time zone) 
(Mountain time zone) 


(Central 
(Eastern 


time zone) 
time zone)"L; 


n <- GetNumfprompt: "Time zone offset from Greenwich "L, min: -12, max: 12, default: -8 
! Question => (WriteLine[ZoneSpiel]; RETRY)]; 

Itp .direction <- IF n<0 THEN west ELSE east; Itp.zone <- ABS[n]; 

1 tp.zoneMinutes «- GetNum[prompt: "Minute offset "L, min: 0, max: 59, default: 0 
! Question => (WriteLine["\rAlmost always zero”L]: RETRY)]; 

Itp.beginDST «■ GetNum[prompt: "First day of DST "L, min: 0, max: 366, default. 121 
! Question => {Writeline[dstSpiel]; RETRY)]; 

Itp.endDST +- GetNum[prompt: "Last day of DST "L, min: 0, max: 366, default: 305 
! Question => {WriteL1ne[dstSpiel]; RETRY}]}; 

PrintHerald: PROC = { 

copyright: STRING = [100]; 
version: STRING = [10]; 

IF useADM THEN WriteChar[’\032]; -- clear screen 
VersionExtras.AppendCopyright[copyright]; 

Version.Append[vers ion]; 

WriteString[copyright]; WriteString["\n\n"L]; 

WriteString["Othello "L]; WriteStr1ng[version]; WriteString[" of ”1]; 

WriteTime[Runtime.GetBcdTime[], FALSE, pacific]}; 
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Pri ritPIDs: PROC = { 

wi Format.StrlngProc = {WriteString[s]}; 

WriteStrlng["Proce$sor = "L]; 

Format.HostNumber[proc: w, 

hostNumber: LOOPHOL£[SpecialSystem.GetProcessorID[]], format: hex]; 
WriteString[" = "L]; 

Format,HostNumber[proc: w, 

hostNumber: LOOPHOLE[SpecialSystem.GetProcessorI[)[]], format: octal]; 
WriteStrlng["6 = "L]; 

Format.HostNumber[proc: w, hostNumber: 

LOOPHOLE[SpecialSystem,GetProcessorID[]], format: productSoftware]; 
NewLlne[]; 

}; 


PrintMemorySize: PROC = { 

s ize ; LONG CARDINAL <- ((Special Space . realMemoryS1ze+255)/256)*64; 
WriteStr1ng["Memory size = ”L]; 

WriteLongNumber[size*2]; 

WriteString["K bytes"LJ; 

NewLinef]; 

}: 

<< The following move to proc. Run 
SetCursor[poInter]; 

PrlntHerald[]; 

Pr1ntPIDs[]; 

PrintMemoryS1ze[]; 

GetTime[];>> 

END. . 


LOG 

Time: 

1-Oct-81 18:44:29 

By: 

FXH 

Action: 

Re-do module. 


Time: 

13-Nov-81 

16:27:44 

By: 

FXH 

add Time Stuff 8 Proc ID 
Action: 8.0e build 


Time: 

l9-Nov-81 

9:26:07 

By: 

FXH 

Make PackedTimeFromString publ 

ic for 

Time: 

17-Dec-81 

17:52:16 

By: 

CRF 

implementing Set8ootFileExpirationDate 
Action: 8.Of build — changed herald. 

Time: 

29-Dec-81 

14:29:14 

By: 

CRF 

Action: 

8.Og build — changed 

he rald. 

Time: 

29“Dec-81 

14:29:14 

By: 

FXH 

Action: 

8.Oh build — changed 

heral d. 

Time: 

l-Feb-82 

16:11:37 

By: 

CRF 

Action: 

8.0i build -- changed 

heral d. 

T Ime: 

3-Feb-82 

15:02:19 

By: 

CAJ 

Action: 

Print processor ID all 

3 

Time: 

8-Feb-82 

17:20:50 

By: 

CRF 

ways using Format. 

Action: 8.0i build -- changed 

heral d. 

Time : 

l-Mar-82 

13:55:31 

By: 

CAJ 

Action: 

final 8,0 build -- changed herald 

Time: 

20-Aug-82 

16:49:26 

By: 

AEF 

Action: 

Change to 9.0b. 


Time : 

16-Sep-82 

11:47:54 By: 

AEF 

Action: 

Change to 9.0c. 


Time: 

24-Sep-82 

17:24:53 

By: 

AEF 

Action: 

Change to 9.0d. 


Time: 

30-Sep-82 

13:48:48 

By: 

AEF 

Action: 

Change to 9.0. 


Time: 

12-Dec-82 

12:50:23 

By: 

RXJ 

Action: 

10.0c; remove Storage. 


Time: 

4-Jun-86 

12:03:59 

By: 

NFS 

Adapted 

for OthelloTool 
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-- Copyright (C) 1983 by Xerox Corporation. All rights reserved. 

-- VolumelnitlmplA.mesa edited by: 

RXJ 2-Dec-83 18:21:20 

RES 17-Oct-83 14:53:35 

NFS 4-Jun-86 14:08:44 

DIRECTORY 

Device USING [PIlotDIsk, Type], 

DeviceTypes USING [ 

q2000, q2010, q2020, q2030, q2040, q2080, salOOO, sal004, sa4000. 
sa4008. t300, t80], 

Environment USING [wordsPerPage], 

File USING [ 

Delete, File, GetAttributes, ID, nullFile, PageNumber, Type. Unknown], 

Heap USING [systemZone], 

Inline USING [BITROTATE], 

OthelloDefs USING [ 

AbortingCommand, CloseFetch, CommandProcessor, Confirm, GetName, 

IndexTooLarge, LeaderPage, leaderPages, IpVersion, MyNamels, NewLine, 

PackedTimeFromString, Question, ReadNumber, RegisterCommandProc, 

SetCommandString, WriteChar, WriteFixedWidthNumber, WriteLlne, 

WriteLongNumber, WrlteOctal, WrlteStrlng, Yes], 

OthelloOps USING [ 

BadSwitches, BootFi1eType, DecodeSwitches, DeleteTempFiles, GetDrlveSize, 

GetNextSubVolume, GetPhysIcalVolumeBootFile, GetSwitches, GetVolumeBootFIle, 
nullSubVolume, SetDebugger, SetDebuggerSuccess, SetExpiratlonDate, 

SetExpirationDateSuccess, SetGetSwitchesSuccess, SetPhyslcalVolumeBootFile, 

SetSwitches, SubVolume, VoldPhysicalVolumeBootFile, VoidVolumeBootFIle], 

OthelloToolDefs USING [CloseVolume], 

PhysicalVolume USING [ 

AssertPilotVolume, DamageStatus, Error, GetAttributes, GetHandle, GetNext, 

GetNextBadPage, GetNextDrive, GetNextlogicalVolume, Handle, ID, 

InterpretHandle, MarkPageBad, maxNameLength, noProblems, nullBadPage, 
nulIDeviceIndex, nullID, Offline, PageNumber, RepairType, Scavenge. 

ScavengerStatus], 

Process USING [MsecToTicks], 

Runtime USING [IsBound], 

Scavenger USING [ 

BootFi1eType. Error, FileEntry, Header, Problem, RepairType, Scavenge], 

Space USING [Copyln, Map, ScratchMap, Unmap], 

SpedalVolume USING [OpenVolume], 

String USING [ 

AppendCharAndGrow, AppendLongNumber, AppendString, CopyToNewString. Equivalent, 

Length, Replace], 

System USING [ 

defaultSwitches, GetLocalTimeParameters, gmtEpoch, GreenwichMeanTime, 

PowerOff, Switches], 

TemporaryBooting USING [BootButton, BootFromVolume], 

Volume USING [ 

Erase, GetAttributes, GetLabelStrlng, GetType, ID, 

NeedsScavenging, NotOnllne, nullID, Open, systemID, Type], 

VolumeVersion USING [Examine]: 

VolumelnitlmplA: PROGRAM 
IMPORTS 

File, Heap, Inline, OthelloDefs, OthelloOps, OthelloToolDefs, PhysicalVolume, Process, Runtime, 
Scavenger, Space, Special Volume, System, String, TemporaryBooting, Volume, 

VolumeVersion 
EXPORTS OthelloDefs 
SHARES File * 

BEGIN OPEN OthelloOps, OthelloDefs: 

commandProcessor: CommandProcessor «- [CommonCommands]: 

CommonCommands: PROC [Index: CARDINAL] = { 

SELECT index FROM 
0 => BootBoot[] ; 

1 => DeleteBootFiles[]; 

2 => DeleteTempFi1e$User[]: 

3 => DescribePhysicalVolumes[]: 

4 => Erase[]: 

5 => ListBadPages[]: 

6 => ListBootF11es[]: 

7 => L1st0rives[]: 

8 *> ListLogicalVolumes[]; 

9 => ListPhysicalVolumesf]; 

10 => MakeBad[]: 

11 => Off1ine[]; 

12 => Online[]: 

13 => PowerOff[]; 

14 => PVScavenge[]; 

15 => Quit[] ; 

16 => Scavenged ; 

17 => SetBootFileSwitches[]; 

18 => SetDebuggerUser[]; 

19 => SetExpiratlonDateUserf]; 

20 => SetPvBoot[]; 

21 => W1zardMode[]: 

ENOCASE => IndexTooLarge}; 

loglcalVolumeTypeStrir»g: ARRAY Volume.Type OF LONG STRING ** [ 

"normal", "debugger", "debuggerDebugger", "nonPIlot"]; 

inputDriveStr1ng: LONG STRING *■ NIL; 

inputLogicalString: LONG STRING <- NIL: 
debuggerLogica I String : LONG STRING «- NIL: 
i nputPhysStri ng : LONG STRING *• NIL; 


VolumelnitlmplA,mesa 


23-Jan-87 12:09:18 PST 




switches: LONG STRING «■ NIL; 

1 vTypeStrlng: LONG STRING «- NIL; 

expirationstring: LONG STRING «- NIL; 

maxNameLength: CARDINAL = PhysicalVolume.maxNameLength; 

BootBoot: PROC = 

BEGIN 

lvID: Volume.ID; 
ts: System.Switches; 

MyNameIs[ 

myNamels: "Boot"L, myHelpIs: "Boot From Logical Volume"L]; 
lvID «- GetLvIDFromUser[] . lvID ; 

GetSetBootFlleSwitches[get, 1vID 
! Volume. NeedsScavenging, File.Unknown => { 

WrlteL1ne["(can’t get default switches)"L]; 

CONTINUE}; 

AbortingCommand => { 

Wr1teL1ne[reason]; 

WriteLine["(can't get default switches)"L]; 

CONTINUE}]; 

DO 

GetName["switches: "L, (^switches, echo, TRUE 
! Question -> { 

Wr1teLlne[ 

"See Pilot Users Handbook for list of valid switches."L]; 

RESUME}] ; 

ts «- DecodeSwitches[switches 

! BadSwitches => {WrlteLine["bad switches"L]; LOOP}]; 

EXIT; 

ENDLOOP; 

IF Runtime.IsBound[LOOPHOLE[CloseFetch]] THEN CloseFetch[]; 

TemporaryBooting.BootFromVolume[lvID, ts]; 

END; 

DeleteBootFIles: PROC = 

BEGIN 

lvID: Volume.ID; 
pvID: PhysicalVolume.ID; 

MyNameIs[ 

myNamels: "Delete Boot Flles”L, 

myHelpIs: "Delete all boot files from volume"L]; 

[pvID; pvID, lvID: lvID] «- GetLvIDFromUser[]; 

IF lvID = Volume.systemID THEN { 

WriteLine["Can not delete boot file of current system volume."L]; 

RETURN;}; 

FOR t: BootFileType IN [hardMicrocode..pilot] DO 
file: File.File - GetVolumeBootFlle[lvID, t].file; 

IF file = File.nul1File THEN LOOP; 

Volume.Open[flie.volumeID]; 

BEGIN ENABLE File.Unknown => CONTINUE; 

File.Delete[file]; 

END; 

VoidVolumeBootFIle[1vID, t]; 

IF GetPhys1calVolumeBootFile[pvID. t].f11e = file THEN 
Vo1dPhys1calVolumeBootFile[pvID, t]; 

OthelloToolDefs.CloseVolume[lvID]; 

ENDLOOP; 

END; 

DeleteTempFIlesUser: PROC = { 

Iv: Volume.ID; 

MyNamelsC 

myNamels: "Delete Temporary Files"L, 
myHelpIs: "Delete Temporary Files"L]; 

Iv «- GetLvIDFromUser[] . 1 vID; 

IF Iv = Volume.systemID THEN { 

writeL1ne["Can not delete temp files on current system volume."LJ; 
RETURN;}; 

DeleteTempFiles[lv]}; 

DescribePhysicalVolumes: PROC = 

BEGIN 

pvID: Physical Vol ume . ID «* PhysicalVolume. nul 1 ID; 

pvFound; BOOLEAN *■ FALSE; 

MyNameIs[ 

myNamels: "Describe Physical Volumes"L, 
myHelpIs: "Describe online physical volume$"L]; 

DO 

h: PhysicalVolume.Handle; 

s: STRING <- [maxNameLength]; 

sV; SubVolume *- nullSubVolume; 

sVFound : BOOLEAN <- FALSE; 

IF (pvID «■ PhysicalVolume .GetNext[pvID]) = PhysicalVolume .nul 1 ID THEN EXIT 
pvFound <- TRUE; 

h «- Physical Vol ume ,GetAttributes[pvID, s ]. instance; 

WriteString["Phys1cal Volume "L]; 

WriteString[s]; WriteString[" on drive ”L]; 

WriteString[GetDr1veStringName[h]]; 

WriteString[" ("L]; 

WriteString[ 

SELECT GetDriveType[h] FROM 

DeviceTypes.sal004, DeviceTypes.salOOO => "Shugart 1000"L, 

OeviceTypes.sa4000, DeviceTypes,sa4008 => "Shugart 4000”L, 

DeviceTypes.q2000, DeviceTypes.q2010, DeviceTypes.q2020, 
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=> "Quantum 2000"L, 


DeviceTypes.q2030, DeviceTypes.q2040, DeviceTypes.q2080 
DevlceTypes.t80 => "T80"L, 

DeviceTypes.t300 => "T300"L, 

ENDCASE => "unknown type"L]; 

DO 

needsScavenging: BOOLEAN <- FALSE; 
freePages, volumeSize: LONG CARDINAL; 
sV <- GetNextSubVolume[pvID, sV]j 
IF sV = nul1SubVolume THEN EXIT; 

IF ~sVFound THEN Wr1teL1ne[") contains:"L]; 
sVFound *■ TRUE; 

WriteString["Volume "L]; 

[volumeSlze: volumeSlze, freePageCount: freePages] <- Volume .GetAttributes[sV. IvID 
! Volume.NeedsScavenging => ( 
needsScavenging «■ TRUE; 
volumeSlze *• 0; -- don't really know 
CONTINUE }]; 

IF volumeSize ft sV.subVolumeSize AND volumeSlze ft 0 THEN 
WriteStr1ng["p1ece "Lj; 

GetLogicalVolumeName[sV.lvID, s]; 

WriteString[s]; WriteString[" (type = "L]: 

WriteStrlng[GetLoglcalVolumeTypeName[sV.1vID]]; WriteString[") ”L]; 

IF volumeSize = sV.subVolumeSize THEN { 

Wr1teLongNumber[freePages]; WriteStringf" of ”L]; 

WriteLongNumber[volumeS1ze]; WriteString[" pages free"L]} 

ELSE {WriteLongNumber[sV.subVolumeSize]; WriteString[" pages"L]}; 

IF needsScavenging THEN WriteString[" *** Needs Scavenging ***"L]; 

NewL1ne[]; 

WriteString[" starting at physical address "L]; 

WriteLongNumber[sV.fIrstPVPageNumber]; 

NewLlne[]; 

IF -needsScavenging THEN ShowBootFi1e$[pvID, sV.lvID]; 

ENDLOOP; 

IF -sVFound THEN WriteLine[") no subvolumes"L]; 

ENDLOOP; 

IF -pvFound THEN WriteL1ne["No physical Volumes found"L]; 

END; 

Erase: PROC = { 

IvID: Volume.ID; 
pvID: Physical Volume.ID; 

MyNamelsC 

myNamels; "Erase"L, myHelpIs; "Erase Logical Vo1ume"L]; 

[pvID: pvID, IvID: IvID] «• GetLvIDFromUser[]; 

IF IvID = Volume.systemID THEN { 

WriteL1ne["Can not erase current system volume."L]; 

RETURN;}; 

Confirmfj; 

OthelloToolDefs.CloseVolume[lvID]; 

SELECT VolumeVersIon.Examine[IvID] FROM 
otherVersion => 

IF Yes["That volume Is not In the current format. Do you want to convert it? "L] 
THEN Confirm[tw1ce] 

ELSE RETURN; 

ENDCASE; 

WriteStr1ng["Erasing..."L]; 

Volume.Erase[lvID]; 

FOR t; BootFileType IN [hardMicrocode..pilot] DO 

IF GetPhys1calVolumeBootFile[pvID, t].file.volumelD = IvID THEN 
VoidPhysicalVolumeBootFile[pvID, t]; 

ENDLOOP; 

WriteL1ne["complete"L]}; 

LIstBadPages: PROC = 

BEGIN 

id: PhysicalVolume.ID; 

page; PhysicalVolume . PageNumber «- PhysicalVolume. null BadPage ; 
badSpots: BOOLEAN «• FALSE; 
col: CARDINAL <- 0; 

MyNameIs[ 

myNamels: "List Bad Pages"L, 

myHelpIs: "List known bad pages on Pilot volume"L]; 
id +■ GetPvIDFromUser[] . id; 

WHILE (page «- PhysicalVolume.GetNextBadPage[id. page]) ft 
PhysicalVolume.nullBadPage 00 
IF col = 6 THEN BEGIN NewL1ne[]; col <- 0; END; 

WriteFixedWidthNumber[page. 11]; 
col col + 1; badSpots <■ TRUE; 

ENDLOOP; 

WriteLine[IF badSpots THEN NIL ELSE "No known bad spot$"L]; 

END; 

ListBootFiles: PROC = 

BEGIN 

IvID: Volume.ID; 

pvID: PhysicalVolume.ID; 

MyNameIs[ 

myNamels: "List Boot Files"L, 

myHelpIs: "List boot files on Pilot volume"L]; 

[pvID: pvID. IvID: IvID] «■ GetLvIDFromUser[]; 

ShowBootF11es[pvID, IvID]; 

END; 

ListOrives: PROC = { 

index: CARDINAL <- Phys icalVolume . nul IDevi celndex; 
first: BOOLEAN *- TRUE; 

MyNameIs[myNameIs: "List Drives"L, myHelpIs: "List Drives"L]; 
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DO 

Index <- PhysicalVolume.GetNextDrive[index]; 

IF Index = PhysIcalVolume.nulIDevIceIndex THEN EXIT; 

IF -first THEN WriteString[" , 
first «■ FALSE: 

WriteString[GetDrlveStringName[Physi cal Volume.GetHandle[index]]]; 
ENDLOOP; 

NewLine[]}; 

ListLogicalVolumes: PROC = 

BEGIN 

first: BOOLEAN «- TRUE; 

pID: PhysIcalVoluma . ID «• PhysicalVolume . null ID; 

MyNamelsf 

myNamels: "List Logical Volumes''L, myHelpIs: "List Logical Volumes"!-]; 
DO 

sV: SubVolume «■ nulISubVolume; 
pID «- PhysicalVolume .GetNext[pID] ; 

IF pID = PhysicalVolume.nul1 ID THEN EXIT; 

DO 

s: STRING <- [maxNameLength]; 
sV «- GetNextSubVolume[pID, sV]; 

IF sV = nullSubVolume THEN EXIT; 

IF sV.f1rstLVPageNumber # 0 THEN LOOP; 

IF -first THEN WriteString[", "L]; 

WriteString[GetDriveStringName[ 

PhysicalVolume.GetAttribetes[pID].instance]]; 

WriteChar[*:]; 

GetLogicalVolumeName[sV.lvID, s]; 

Wr1teString[s]; 
first <- FALSE; 

ENDLOOP; 

ENDLOOP; 

WriteLineflF first THEN "No logical volumes found"L ELSE NIL]; 

END; 

LIstPhysi calVolumes: PROC = 

BEGIN 

s: STRING = [maxNameLength]; 

drivestring: LONG STRING; 

first: BOOLEAN *■ TRUE; 

pID: PhysicalVolume . ID «- Phys 1 cal Vol ume, nul 1 ID; 

MyNameIs[ 

myNamels: "List Physical Volumes"L, 
myHelpIs: "List Physical Volumes'^]; 

DO 

pID *■ PhysicalVolume .GetNextfpID] ; 

IF pID = PhysicalVolume.nullID THEN EXIT; 
drivestring *- GetDriveStringName[ 

PhysicalVolume.GetAttributes[pID, s].instance]; 

IF -first THEN WriteStr1ng[”, "L]; 

WriteString[dr1veString]; 

WriteChar[':]; 

WrlteString[s]; 
first +- FALSE; 

ENDLOOP; 

WriteLine[IF -first THEN NIL ELSE "No physical volumes found"L]; 

END; 

MakeBad: PROC = 

BEGIN 

h: PhysicalVolume.Handle; 

id: PhysicalVolume.ID; 

page: Physical Volume.PageNumber; 

IF ~Wizard[] THEN RETURN; 

MyNameIs[ 

myNamels: "Make Page Bad"L, 

myHelpIs: "Enter page into bad page table"L]; 

[id, h] «• GetPvIDFromUser[]; 

page *• ReadNumber["Dec1mal Page Number: "L, 0, GetDriveSize[h] - 1]; 
PhysicalVolume,MarkPageBad[id. page]; 

WriteLine[”Consider scavenging some logical volumes."L]; 

END; 

Offline: PROC = { 

MyNameIs[ 

myNamels: "Offline"L, myHelpIs: "Bring physical volume offline"L]; 
Physical Volume.Off11ne[GetPvIDFromUser[].id]}; 

Online: PROC = { 

pvID: PhysicalVolume.ID; 

MyNamels[ 

myNamels: "Online"L, myHelpIs: "Bring drive onl1ne"L]; 
pvID + PhysicalVolume.AssertPilotVolume[GetDriveFromUser[] ! 

PhysicalVolume.Error => IF error = alreadyAsserted THEN CONTINUE]; 

-- (maybe) update time parameters on disk 
[] «■ System.GetLocalTimeParameters[pvID]} ; 

PowerOff: PROC [ 

MyNameIs[ 

myNamels: "Power Off", myHelpIs: "Execute System.PowerOff"L]; 
Confirm[]; CloseFetch[] ; System.PowerOff[]}; 

PVScavenge: PROC = 

BEGIN OPEN PV: PhysicalVolume; 
convert: BOOLEAN «- FALSE; 
s: PV.ScavengerStatus; 
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h: PV.Handle; 

repair: PV.RepalrType; 
p: PV. ID <- PV. null ID; 

PrintDamageStatus: PROC [s: STRING, d: PV.DamageStatus] * { 
IF d=okay THEN RETURN; 

WriteStr1ng[s]; 

WriteLineflF d=damaged THEN " damaged"L ELSE " lost"L]}: 


MyNameIs[ 

myNamels: "Physical Volume Scavenger, 
myHelpIs; "Scavenge physical volume"!.]; 
h *■ GetDr1veFromUser[] ; 
repair «- 

IF ~Yes[”Repa1r? "L] THEN checkOnly 

ELSE IF Wlzardf] AND YesfRisky repair? ”L] THEN riskyRepair ELSE safeRepalr; 
Conf1rm[]; 

DO 



IF (p^PhysicalVolume.GetNextfp]) s Physical Volume.nul1 ID THEN EXIT; 

IF h = Physical Volume.GetAttr1butes[p].Instance THEN { 

Physical Volume.Off!ine[p]; EXIT}; 

ENDLOOP; 

BEGIN ENABLE PhysicalVolume.Error => 

IF error = needsConversion AND ^convert THEN 

IF (convert «- Yes["That volume is not In the current format. Do you want to convert 
THEN {Conf1rm[]; RETRY} 

ELSE Abort1ngCommand[''Volume cannot be scavenged"L]; 

Wr1 testring["Scavenging..."L]; 
s <- PV.Scavenge[h, repair, convert]; 

Wr1tellne["Complete"l]; 

END; -- ENABLE 

IF s a PV.noProblems THEN {WrlteLine["No problems detected"L]: RETURN}; 
Wr1teString["Damage detected: "L]; 

IF s.internalStructures # okay THEN { 

WrlteString["Internal structures M L]; 

Wr1teLine[ 

IF s.internalStructures-damaged THEN 

IF repair=safeRepair THEN "damaged -- contact hardware support for risky repair"L 
ELSE "damaged"L 
ELSE "repaired”L]}; 

Pr1ntDamageStatus["Bad page list"L, s.badPageLIst]; 

Pr1ntDamageStatus["Boot file"L, s.bootFlle]; 

PrintDamageStatusfGerm”L, s.germ] ; 

Pr1ntDamageStatus["Pilot m1crocode"L, s.softMicrocode]; 

PrintDamageStatusf"Diagnostic m1crocode"L, s.hardMicrocode]; 


Quit: PROC = { 

MyNamelsf 

myNamels: "Quit"L, myHelpIs: "Push the boot button"L]; 

Conflrmf]; CloseFetch[]; TemporaryBooting.BootButton[]}; 

Scavenge : PkdL =' t - ' 

convert: BOOLEAN *• FALSE; 

1vID: Volume.ID; 

logFile: File.File; 

logPage: File .PageNumber <- 0; 

logWd: CARDINAL *■ Environment.wordsPerPage; 

buffer: LONG POINTER TO ARRAY [0..Envlronment.wordsPerPage) OF UNSPECIFIED 


it? "L]) 


GetWds: PROC [p: POINTER, c: CARDINAL] = { 

WHILE c#0 DO 

IF logWd=Environment.wordsPerPage THEN { 

[] *■ Space.CopyIn[buffer, [logFile. logPage, 1]]; 
logPage <- logPage + 1; logWd *■ 0}; 
pt <- buffer[logWd]; 
p *■ p+1; c «■ c-1; logWd «- logWd+1; 

ENDLOOP}; 

DIsplayScavLog: PROC = { 

fileCount: LONG CARDINAL; problems: BOOLEAN «- FALSE; 

BEGIN 

hd: Scavenger.Header; 

GetWds[@hd, SIZEfScavenger.Header]]; 

WriteString["volume"L]; IF ~hd.repaired THEN WriteStringf not"L]; 
WriteString[" repaired, log fi1e”L] ; 

IF hd.incomplete THEN WriteString[" not"L]; WriteLine[" complete "L]; 
WriteLongNumber[f ileCount <- hd. numberOfFiles]; 

WriteLine[" files on volume"L]; 

END; 

WHILE fileCounti^O DO 

OpenID: TYPE = ARRAY [0..SIZE[File.ID]) OF CARDINAL; 
fe; Scavenger.FileEntry; 

GetWds[@fe, SIZEfScavenger.Fi1eEntry]]; 

THROUGH [0..fe.numberOfProblems) DO 
fp: Scavenger.Problem; 

GetWdsfQfp, SIZEfScavenger.Problem]]; 

WriteCharf'f]; 

FOR i; CARDINAL IN fO..SIZEfFile.ID]-1) DO 
WriteOctal[LOOPHOLEffe.file, 0penID][1]]; WriteStringf", ”L] ENDLOOP; 
WriteOctalfLOOPHOLEffe.file, OpenID]fSIZEfFile.ID]-1]]; 

WriteStringf] type = "L]; 

BEGIN ENABLE File.Unknown => GOTO noType; 

f: File.Type = File.GetAttrlbutesfffe.file, IvID]].type; 

WriteLongNumberfL0NG[L00PH0LE[f, CARDINAL]]]; 

EXITS noType => WriteStringfunknown"L]; 

END; 

WriteStringf; ”L]: 

WITH fp SELECT FROM 
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unreadable => { 

WriteString["unreadable"L]; 

WriteStr1ng[" pages ["!_]; WriteLongNumber[first]; 

WriteString[".."L]; WriteLongNumber[first+count]; WriteLine[”)"L]}; 
missing => { 

WriteString["miss1ng"L]; 

WriteString[" pages [*'L]; WriteLongNumber[f 1 rst] ; 

WriteString[".."L]; WritelongNumber[f1rst+count]; Wr1teLine[")"L]}; 
duplicate => { 

Wr1teString["dupl1cate"L]; Wr1teLine[" page found"L]}; 
orphan => { 

Wr1teString["orphan"L]; WriteLine[" page found"L]}; 

ENDCASE = > WriteLine["unknown prob1em"L]; 
problems + TRUE; 

ENOLOOP; 

flleCount + fileCount-1: 

ENDLOOP; 

WriteLine[IF -problems THEN "No problems found"L ELSE NIL]}; 

MyNamels} 

myNamels: "Scavenge"L, myHelpIs: "Scavenge Logical Volume"L]; 

1 vID «- GetLvIDFromUser[ j . 1 vID; 

IF lvID = Volume.systemID THEN { 

WriteLine["Can not scavenge current system volume. "L]; 

RETURN;}; 

Confirm[]; 

OthelloToolDefs.CloseVolume[lvID ! ANY => CONTINUE]; 

BEGIN ENABLE Scavenger.Error 3 > 

IF error = needsConversion AND -convert THEN 

IF (convert + Yes["That volume is not in the current format. Do you want to convert it? "Lj) 
THEN {Confirm[twice]; RETRY} 

ELSE Abort1ngCommand["Volume cannot be scavenged"L]; 

WriteString["Scavenging..."L]; 

logFile <• Scavenger.Scavenge[lvID, lvID, safeRepair, convert]; 

WriteLinef"Comp!ete"L]; 

END; -- ENABLE 

SpecialVolume.OpenVolume[lvID, read]; 
buffer + Space.ScratchMap[1]; 

DisplayScavLog[ 

! UNWIND => {[] + Space.Unmap[buffer]; Othel1oToolDefs.CloseVolume[lvID]}]; 

[] «- Space .Unmap[buffer] ; OthelloToolDefs.CloseVolume[lvID]}; 

SetBootFileSwitches: PROC = 

BEGIN 

ts: System.Switches; 

lvID: Volume.ID; 

MyNameIs[ 

myNamels: "Set Boot File Default Switches'^, 

myHelpIs: "Set default switches for boot file on volume"L]; 

1vID + GetLvIOFromUser[].lvID; 

GetSetBootFileSwitches[get. lvID]; -- volume.needsScav (caught higher up) 

DO 

GetName["switches: "L, @$w1tches, echo. TRUE 
! Question => {WriteLine[ 

"See Pilot Users Handbook for list of valid switches."L]; 

RESUME}]; 

ts + DecodeSw1tche$[switches 

! BadSwItches => {WrlteLIne["bad switches'^]; LOOP}]; 

EXIT; 

ENDLOOP; 

Confirm[]; 

GetSetBootFileSwitches[set, lvID, ts]; 

END; 

SetDebuggerUser: PROC = 


BEGIN 

file: 

File.File: 

firstPage: 

File.PageNumber; 

1 vID: 

Volume.ID; 

dLvID: 

Volume.ID: 

dH : 

PhysicalVolume.Handle; 

dT: 

Device.Type: 

dO: 

CARDINAL; 

outcome: 

SetDebuggerSuccess; 

MyNameIs[ 



myNamels: "Set Debugger Pointers"L, 
myHelpIs: "Set up pointers to debugger for volume"L]; 
lvID <- GetLvIDFromUser["for debuggee Logical Volume: ’*L] . lvID; 

[file, firstPage] + GetVolumeBootFile[1vID, pilot]; 

IF file = File.nul1Fi1e THEN 

AbortingCommand["No boot file found."L]; 

[, dLvID, dH] + GetLvIDFromUser["for debugger Logical Volume: "L, TRUE]; 
IF dLvID=Volume.nul1 ID THEN WriteLine["(Clear existing pointers)"L] 

ELSE {dT «- GetDriveType[dH]; dO + GetDriveNumber[dH]}; 

Confirm[]; 

Volume.Open[l vID]; 
outcome + SetDebugger[ 

debuggeeFi1e: file, debuggeeFirstPage: firstPage. debugger: dLvID, 
debuggerType: dT. debuggerOrdinal: dO]; 

OthelloToolDefs.CloseVolume[lvID]; 

WriteSetDebuggerSuccess[outcome]; 

END; 

SetExpirationDateUser: PROC = 

BEGIN 

file: File.File; 
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f1rstPage: 
time: 

1 vID: 
outcome: 


File.PageNumber; 
System.GreenwichMeanTime; 
Volume.ID; 

SetExpIratlonDateSuccess; 


MyNameIs[ 

myNamels: "Set Hardware Clock Upper Lim1t"L, 

myHelpIs: "Set last believable hardware clock date for boot file on logical volume"!.]; 
1 vID «• GetLvIDFromUser[] . lvID; 

[file, firstPage] *- GetVolumeBootfile[lvID, pilot]; 

IF file = F11e.nul1 File THEN 

AbortingCommand["No boot file found."Lj; 

DO 

GetName["Date (DD-MMM-YY): "L, @expirationString]; 

IF expirationstring.length=0 THEN { 

WriteLine[''(setting no upper limit on hardware clock)"L]; 
time «- System.gmtEpoch; 

EXIT} 

ELSE { 

time <- PackedTimeFromString[s : expi ratlonStrl ng , justDate: TRUE]; 

IF t1me=System.gmtEpoch THEN WriteLine["inval1d date"L] 

ELSE EXIT}; 

ENDLOOP; 

Conf1rm[]; 

Volume.Open[lvID]; 
outcome «- SetExpirat1onDate[f 1 le . 

OthelloToolDefs.CloseVolume[lvID]; 

Wr1teSetDebuggerSuccess[outcome]; 

_ENQ; 


firstPage. time]; 


SetPvBoot: PROC = 

BEGIN 

lvID: Volume.ID; 

set: ARRAY BootFileType[hardMicrocode..pilot] OF BOOLEAN 
found, changed: BOOLEAN <- FALSE; 

Smash: PROC [s: STRING, t: BootFileType] = [ 


ALL[FALSE]; 


IF GetVolumeBootFi1e[lvID, t].file = FIle.nullFile THEN RETURN; 
found <- TRUE: 

WriteString["Set physical volume ”L]; 

WriteString[s]; 

IF (set[t] «- Yes[" from this logical volume? "L]) THEN changed «- TRUE}; 
MyNameIs[ 

myNamels: "Set Physical Volume Boot Files"L, 
myHelpIs: "Set Physical Volume Boot Fi1es"L]; 
lvID *■ GetLvIDFromUser[] . lvID; 

Smash["boot f11e"L, pilot]; 

Smash["pilot microcode"L, softMicrocode]; 

Smash["germ file ,, L, germ]; 

Smash["diagnost1c microcode"L, hardMicrocode]; 

IF -found THEN AbortingCommand["Log1cal volume has null boot files"L]; 

IF -changed THEN RETURN; 

Conf1rm[]; 

SpecialVolume.OpenVolume[lvID, read]; 

FOR t; BootFileType IN [hardMicrocode..pilot] DO 
IF set[t] THEN { 
file; File.File; 
firstPage: File.PageNumber; 

[file, firstPage] «- GetVolumeBootFile[lvID, t]; 
SetPhysicalVolumeBootFi1e[file, t. firstPage]}; 

ENDLOOP; 

Othel loToolDefs.CloseVolume[lvID]; 

END; 


ShowBootFiles: PROC [pv: PhysicalVolume.ID, lv: Volume.ID] = { 
bootNames: ARRAY BootFileType[hardMicrocode. .pilot] OF STRING «- [ 
hardMicrocode: "Diagnostic microcode"L, 
softMicrocode: "Pilot microcode"L, 


germ: "Germ'’L, 

pilot: "Pilot bootfile"L]; 

SpecialVolume.OpenVolume[lv, read ! Volume.NeedsScavenging => GOTO scavenge]; 
FOR t: BootFileType IN BootFi1eType[hardM1crocode..pilot] DO 
ENABLE UNWIND => Othel1oToolDefs.CloseVolume[lv]; 
file: File.File; 
firstPage: File.PageNumber; 

[file: file, firstPage: firstPage] <- GetVolumeBootF i 1 e[l v . t]; 

IF file = File.nul 1 f ne then loop-, 

WriteString[" "L]; 

IF GetPhysicalVolumeBootFile[pv, t].file = file THEN 
WriteString["(PV) "L]; 

WriteString[bootNames[t]]; 

WriteString[": "L]; 

IF firstPage = OthelloDefs.leaderPages THEN ShowLeaderNote[file] 

ELSE WriteL1ne["(no Information available)"L] ; 

ENDLOOP: 

OthelloToolDefs.CloseVolume[lv]; 

EXITS 

scavenge => NULL}; 


ShowLeaderNote: PROC [file: File.File] = { 

Ip: LONG POINTER TO Othel1oDefs.LeaderPage; 

Ip *■ Space.Map[window:[file, 0, OthelloOefs. leaderPages] , access: readonly] .pointer; 
IF Ip.version = OthelloDefs.IpVersion THEN 

FOR i: CARDINAL IN [0.. Ip . length) DO WriteChar[lp.note[1]] ENDLOOP 
ELSE Wr1teString["(no information available)"L]; 

NewLine[]: 
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[] <- Space.Unmap[lp]}; 


WizardMode: PROC = { 

password: LONG STRING <- NIL; 

IF wizardMode THEN RETURN; 

MyNameIs[ 

myNamels: "Wizard Mode”L, myHelpIs: "Enable special commands”L]: 
GetName["Password: "L, ©password, stars]; 

IF Hash[password] = wizardPassword THEN {wizardMode *■ TRUE; Wr1teLine[" ok"L]} 
ELSE Wr1teLlne[" Incorrect password''L]}: 

Wizard Supporting Procedures 

wizardMode: BOOLEAN *■ Process .MsecToT ick$[2000] # 39; --FALSE for DLion only. 
wizardPassword: CARDINAL a 18939; 

Hash: PROCEDURE [s: LONG STRING] RETURNS [h: CARDINAL] = 

BEGIN 
h <- 17777; 

FOR i; CARDINAL IN [0..String.Length[s]) DO 
c: CHARACTER; 

IF (c ♦- s[1]) IN [ 1 A. . 1 Z] THEN c <- c + ( * a-'A); 
h 4- Ini ine .BITROTATE[h , 1] + (c-OC); 

ENDLOOP; 

END; 

Wizard: PUBLIC PROC RETURNS [BOOLEAN] = [RETURN[wizardMode]}; 

-- Volume Init Supporting Procedures 
unknown: LONG STRING * "Unknown"; 


GetSetBootFileSwitches: PROC [ 

getSet: {get. set}, 1vID: Volume.ID, 

ts: System.Switches «- System.defaultSwitches] = { 

outcome: SetGetSwItchesSuccess; 

file: File.File; 

firstPage: Fi1e.PageNumber; 


Heap.systemZone.FREE[©switches]; 

IF getSet=get THEN SpecialVolume.OpenVo1ume[lvID, read] 

ELSE Volume.Open[lvID]; 

[file, firstPage] *■ GetVolumeBootFi 1 e[lvID, pilot]; 

IF file s File.nullFIle THEN AbortingCommand["No boot file found."L]; 

IF getSet=get THEN [outcome, ts] <- GetSwitches[file, firstPage] 

ELSE outcome «■ SetSw1tches[flie, firstPage, ts]; 

Othel1oToolDefs.CloseVolume[lvID]; 

WriteSetDebuggerSuccess[outcome]; 

IF getSet=set THEN RETURN; 

FOR c: CHARACTER IN [0C..377C] DO 
IF ts[C]-up THEN LOOP; 

SELECT c FROM 

'W, ", *> NULL; 

IN ['a..*z], IN ['A..'Z], IN (’ ..'?] => { 

String.AppendCharAndGrow[©switches, c, Heap.systemZone]; LOOP}; 

ENDCASE => NULL; 

String.AppendCharAndGrow[@switches, *\\, Heap.systemZone]; 

String.AppendCharAndGrow[@sw1tches, (c-0C)/64 + '0, Heap.systemZone]; 

String.AppendCharAndGrow[@switches, ((c-0C)/8 MOD 8) + '0, Heap.systemZone]; 
String.AppendCharAndGrow[@sw1tches, ((c-OC) MOD 8) + ’0, Heap.systemZone]; 
ENDLOOP}; 


WrlteSetDebuggerSuccess: PROC [outcome; SetDebuggerSuccess] = { 

SELECT outcome FROM 
success -> NULL; 

nullBootFile, cantWrlteBootFIle, notlnitialBootFile => 

AbortingCommand["Boot file broken.”L]; 
cantFindStartListHeader, startListHeaderHasBadVersion => 

AbortingCommand["f1le built by incompatible version of StartP11ot"L]; 
noDebugger -> AbortingCommand["No debugger installed."L]; 

ENDCASE => ERROR}; 


GetDriveFromUser: PUBLIC PROC RETURNS [h: PhysicalVolume.Handle] = { 

DO 

index: CARDINAL «- PhysicalVolume . nullDevIcelndex ; 

GetName[ 

"Drive Name: "L. ©inputDriveString, echo, TRUE 
! Question => {ListDrives[]; RESUME}]; 

IF inputDriveString[inputDriveString.length -!]=’: THEN 
inputDriveString . 1 ength inputDrlveString. 1 ength 1; 

DO 

index *■ Physl cal Vol ume ,GetNextDr1ve[ i ndex] ; 

IF index = Physical Volume.nulIDevicelndex THEN EXIT; 
h «- PhysicalVolume.GetHandle[index]; 

IF String.Equivalent[GetDriveStringName[h], inputDriveString] THEN RETURN; 
ENDLOOP; 

WriteL1ne["Drive not foundf'L] 

ENDLOOP}; 

GetDriveNumber: PUBLIC PROC [h: PhysicalVolume.Handle] RETURNS [CARDINAL] = { 
RETURN[Physleal Volume.InterpretHandie[h].index]}; 

GetDriveStrlngName; PROC [h: PhysicalVolume,Handle] RETURNS [s: LONG STRING] = 
BEGIN 

S + SELECT TRUE FROM 

-- damn compiler won't allow t IN Device.PilotDisk 
LOOPHOLE[GetDriveType[h], CARDINAL] IN Dev ice.PllotOisk 
= > "Rd?'\ 

ENDCASE => "UnknownType?"; 
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s[s. length - 1] +• GetDriveNumberfh] + ’O; 
END; 


GetDriveType: PUBLIC PROC [h; PhysicalVolume.Handle] RETURNS [Device.Type] = { 
RETURN[Physleal Volume.InterpretHandle[h].type]}; 

GetLoglcalVolumeName: PROC [vid: Volume.ID, s: STRING] = { 
s.length <* 0; 

Volume.GetLabelStrlng[v1d, s ! Volume.NeedsScavenging => GOTO bad]; 

EXITS bad => { 

IDRep: TYPE = RECORD [p: ARRAY [0..3) OF CARDINAL, n: LONG CARDINAL]; 

String.AppendString[s, "NeedsScaveng1ng"L]; 

String.AppendLongNumber[s, LOOPHOLE[v1d, IDRep],n, 8]}}; 

GetLogicalVolumeTypeName: PROC [vid: Volume.ID] RETURNS [LONG STRING] = { 
RETURN[loglcalVolumeTypeStr1ng[Volume.GetType[vid ! ANY => GOTO signal]]]; 

EXITS signal => RETURN[unknown]}; 

Accept string of Form LogicalVolumeName OR 
Drive:Log lealVolumeName 
GetLvIDFromUser: PUBLIC PROC [ 
prompt: LONG STRING «■ NIL, 
cal ledFromSetDebuggerPtrs : BOOLEAN «■ FALSE] 

RETURNS [ 

pvID: Physical Volume.ID, IvID: Volume.ID, 
drive: PhysicalVolume.Handle] = 

BEGIN 

IF prompt = NIL THEN prompt <- "Logical Volume Name: "L; 

DO 

ptmpID: Physical Volume . ID *■ PhysicalVolume . nul 1 ID; 

Inputstring: LONG STRING; 
matches: CARDINAL <- 0; 

GetName[ 

prompt: prompt, how: echo, sIgnalQuestlon: TRUE, 
dest: IF calledFromSetDebuggerPtrs THEN QdebuggerLogicalString 
ELSE QinputLogicalString 
! Question => {ListLog1calVolumes[]; RESUME}]; 

IF calledFromSetDebuggerPtrs THEN { 

IF debuggerLog leal String. 1 ength=0 THEN (lvID *• Volume, nul 1 ID; RETURN} 

ELSE Inputstring *■ debuggerLogicalString} 

ELSE {Inputstring «• InputLogicalString}; 

DO 

drlveTemp: PhysicalVolume.Handle; 

ItmpID: Volume.ID <■ Vol ume. null ID; 

IF (ptmpID <- PhysicalVolume ,GetNext[ptmpID]) = PhysicalVolume.nul1 ID THEN EXIT; 
drlveTemp <- PhysicalVolume .GetAttributes[ptmpID] . instance ; 

DO 

s: STRING 5 [maxNameLength]; 

IF (ItmpID <- PhysicalVolume .GetNextLogicalVolumefptmpID, ItmpID]) 

= Volume.nullID THEN EXIT; 

GetLog1calVolumeName[ltmpID, s ! Volume.NotOnline => LOOP]; 

IF FunnyEqual[dr1veTemp, s, inputstring] THEM { 

matches *■ matches + 1; IvID «- ItmpID; pvID «- ptmpID; drive «■ driveTemp}; 
ENDLOOP; 

ENDLOOP; 

SELECT matches FROM 

0 => Wr1teStr1ng[”Not found\r"L']; 

1 => RETURN; 

ENDCASE => WriteLine["Ambigous; please specify Device:LogicalName"L]; 

ENDLOOP; 

END; 

FunnyEqual: PROC [ 

h; PhysicalVolume.Handle, name: STRING, userName: LONG STRING, 
mode: (checkNakedPName, dontCheckNakedPName} <- dontCheckNakedPName] 

RE TURNS[BOOLEAN] = ( 
drlveName: LONG STRING; 

SameChar: PROC [a, b: CHARACTER] 

RETURNS [BOOLEAN] = { 

IF a=b THEN RETURN[TRUE] 

ELSE IF a IN ['a..’z] AND b IN ['A..'Z] AND (a-’a+'A)=b THEN RETURN[TRUE] 

ELSE IF a IN [’A..’Z] AND b IN ['a..'z] AND (a-’A+*a)=b THEN RETURN[TRUE] 

ELSE RETURN[FALSE]}; 

IF String.Equivalent[name, userName] THEN RETURN[TRUE]; 
drlveName <- GetDriveStr1ngName[h]; 

IF userName.length < driveName.length THEN RETURN [FALSE]; 

FOR i; CARDINAL IN [0..drlveName.length) DO 

IF ~SameChar[dr1veName[i], u$erName[i]] THEN R£TURN[FALSE] ENDLOOP; 

IF mode=checkNakedPName THEN { 

IF (userName.length=driveName.length) 

OR (userName.length=dr1veName.length+1 

AND userName[driveName.length] = ':) THEN RETURN[TRUE]}; 

IF drlveName . length+name . length+1 ft userName . 1 ength THEN RETURN[FALSE] ; 

IF userName[driveName.length] # THEN RETURN[FALSE]; 

FOR i: CARDINAL IN [0..name.1ength) DO 

IF ~SameChar[name[i], userName[driveName.length+l+i]] THEN RETURN[FALSE] 

ENDLOOP; 

RETURN[TRUE]}; 

GetLvTypeFromUser: PUBLIC PROC [ 

prompt; LONG STRING, defaultType: Volume.Type] RETURNS [Volume.Type] = 

BEGIN 

LIstTypes: PROC = { 

FOR t: Volume.Type IN [normal..nonPIlot] DO 
WriteString[logicalVolumeTypeString[t]]; 

WriteString[IF t = nonPilot THEN "\r"L ELSE ", "L]; 

ENDLOOP}; 
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«! 


String.Rep 1ace[@lvTypeString, logicalVolumeTypeString[defaultType], Heap.systemZone]; 

DC) 

GetName[prompt, SlvTypeStrlng, echo, TRUE 
! Question => {LIstTypes[]; RESUME}]; 

FOR t: Volume.Type IN [normal..nonPIlot] DO 

IF String.Equivalent[logicalVolumeTypeString[t], 1vTypeString] THEN 
RETURN[t] 

ENDLOOP; 

WriteL1ne["Illegal type"L]; 

ENDLOOP; 

END; 

-- Accept string of Form PhysicalVolumeName OR 
Drive:PhysicalVolumeName OR Drive 
GetPvIDFromUser; PROC 

RETURNS [Id: PhysicalVolume.ID, drive; PhysicalVolume.Handle] a 

BEGIN 

DO 

tmpID: Physical Vol ume . ID <- Phys ical Vol ume. null ID; 

matches: CARDINAL <- 0; 

GetName[''Physical Volume Name: "L, QlnputPhysStri ng, , TRUE 
! Question s > {L1stPhysicalVolumes[]; RESUME}]; 

DO 

s: STRING s [maxNameLength]; 

match: BOOLEAN; 

driveTemp: PhysicalVolume.Handle; 

IF (tmpID «- PhysicalVolume .GetNext[tmpID]) - PhysicalVolume.nullll) THEN 
EXIT; 

drlveTemp «- Physical Volume .GetAttributes[tmpID, s]. instance; 
match <- FunnyEqual [driveTemp , s. InputPhysString , checkNakedPName]; 

IF match THEN {matches *- matches + 1; id ♦* tmpID; drive *■ driveTemp}; 

ENDLOOP; 

SELECT matches FROM 

0 => WriteLine["Not Found"L]; 

1 => RETURN; 

ENDCASE => WriteLine["Ambigous; please specify Device:PhysicalName"L]; 

ENDLOOP; 

END; 

Stringlnit; PROC = { 

SetCommandString[String.CopyToNewString["Online RD0"L, Heap.systemZone]]}; 
debuggerLogicalString *■ String,CopyToNewString["CoPilot"L, Heap .systemZone] ; 

RegisterCommandProc[@commandProcessor]; 

Stringlnitf]; 

END. 

March 19, 1980 3:47 PM FXH Delete newly created temporary files when fetch fails; ome indentation changing 

April 16. 1980 12:16 PM RXG Addd diagnostic microcode fetch 

May 31. 1980 11:49 PM FXH Shuffle around VolumelnitlmplA and B 

July 30, 1980 4:33 PM AWL Permit Online'lng an already online volume 

September 18, 1980 12:04 PM PXM Don't bother to open volume to boot from 

September 19, 1980 11:24 AM AWL physicalVolumeOverhead «- 2 for new physical volume format. 

September 29. 1980 2:07 PM CAJ Add SA800 format and scan, USING clauses. 

October 10. 1980 3:17 PM FXH Version 5.0. 

January 5. 1981 10:14 PM FXH Made use String for appendChar, equivilantString, appendLongNumber. Add FemporaryBootlng.1nvalid 

paramater catch. 

January 31. 1981 9:19 PM CAJ Fix format prompt. 

March 1. 1981 12:59 PM AWL Version => 6.0b. 

March 13, 1981 7:22 PM SXY Version => 6,0c, trouple => trouble (correction), "Boot file header broken" => "Error: Debuggee built by 

incompatible version of StartPilot". 

March 25, 1981 8:28 PM CRF Version => 6.0. 

April 14. 1981 11:38 AM BXM 0 added. 

11- Jun-81 10:53:01 Taft Remove all machine- and device-dependent code to separate module Qthel1oDevicelmplD*.mesa 

17-Jul-81 15:34:33 SCG Merged OthelloDevIce into OthelloDefs 

12- Aug-81 12:33:54 SXY Added a catch phrase for Vo Iume.GetAttributes and commented it out for Volume.GetLabelStrlng 

5-Dec-81 17:30:28 CRF Converted from PhysicalVolumeExtras to PhysicalVolume for PV scavenger. 

ll-Dec-82 15:10:21 RXJ Removed Storage. 

13- Apr-83 12:27:04 RXJ Klamath conversion 

4-Jun-86 14:09:04 NFS Adapted for OthelloTool 
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-- VolumeVersion.mesa 17-Aug-B3 12:16:18 by WDK 

-- TEMPORARY HACK for Klamath <> Trinity cross volume problems. 

DIRECTORY 

Volume USING [ID]; 

VolumeVersion: DEFINITIONS = 

BEGIN 

Examine: PROCEDURE [volume: Volume.ID] 

RETURNS [result: Result]; 

Result: TYPE = { 

currentVersion, badRootPageLabel, loError, trashedRootPage, 
otherVersion, volumeUnknown); 

END. 
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-- Copyright (C) 1983, 1984 by Xerox Corporation. All rights reserved. 

-- VolumeVersionlmpl.mesa 17-Aug-83 11:20:47 by WDK 

-- BJO 28-Feb-84 14:10:16 

-- TEMPORARY HACK for Klamath <> Trinity cross volume problems. 

DIRECTORY 
Device, 

DlskChannel, 

Envi ronment, 

File, 

Log I calVolumeFormat, 

OthelloOps, 

PhysicalVolume, 

Pi lOtDisk, 

PilotFileTypes, 

Space, 

VM, 

Volume, 

Vo 1umeVerslon; 

VolumeVersionlmpl: PROGRAM 
IMPORTS 

DlskChannel, Environment, OthelloOps, PhysicalVolume, PilotDisk, Space, VM 
EXPORTS VolumeVersion s 
BEGIN 

Bug: SIGNAL [b: BugType] = CODE: 

BugType: TYPE - { 

impossIbleEndcase, InvalidChannel, invalidDrlveState}; 

Examine: PUBLIC PROCEDURE [volume: Volume.ID] 

RETURNS [result: VolumeVersion.Result] = 

BEGIN 

IvRoot: LONG POINTER TO LogicalVolumeFormat.Descriptor; 
physicalVol: PhysicalVolume.ID = 

PhysicalVolume.GetContalningPhyslealVolume[volume]: 
pvHandle: PhysicalVolume.Hand!e = 

PhysicalVolume.GetAttributes[physi calVol].instance: 
devIceType: Device.Type: 

Index: CARDINAL; 

subVolume: OthelloOps.SubVolume *■ OthelloOps.nulISubVolume : 
drive: 01skChannel.Drive : 

DO 

subVolume Othel loOps .GetNextSubVolume[phys1calVol , subVolume]: 

IF subVolume = OthelloOps.nullSubVolume THEN RETURN[volumeUnknown]: 

IF subVolume.IvID = volume AND subVolume.f1rstLVPageNumber = 0 THEN EXIT; 
ENDLOOP; 

IvRoot *■ Space.ScratchMap[count: 1].pointer; 

[type: devIceType, Index: Index] <- PhysicalVol ume. InterpretHandle[pvHandle]: 
FOR drive <- DiskChannel.GetNextDrivefprev: DiskChannel .nullDrlve] , 

DlskChannel.GetNextDrive[prev: drive] 

UNTIL drive = D1skChannel.null Drive DO 
dType: Device.Type; 
dOrdlnal: CARDINAL; 

[devIceType: dType, deviceOrdinal : dOrdlnal] «■ 

DiskChannel.GetOriveAttributes[drive]; 

IF dType=deviceType AND dOrdinal* index THEN EXIT 
ENDLOOP; 

BEGIN --scope of Exlt-- 

pageBuffer: Environment.PageNumber = Environment.PageFromLongPointer[IvRoot]: 
channel: DlskChannel.Handle = DlskChannel,Create[drlve]: 
request: Di skChannel . IORequest «- [ 

dlskPage: subVolume.firstPVPageNumber, memoryPage: pageBuffer, 
tries: DiskChannel .defaultTries. label: Olabel, 
count: 1, useSamePage: TRUE, command: [verify, read, read]]; 
status: DlskChannel.IOStatus ; 
countValid: Fi1e.PageCount; 
label: PilotDisk.Label: 

VM.MakeResident[[page: pageBuffer, count: 1], wait]; 

[status, countValid] *■ Di skChannel .DoIO[channel , ^request]; 

WITH boundStatus: status SELECT FROM 
invalidChannel -> Bug[invalidChannel] : 
invalidDrlveState => Bug[invalidDrlveState]; 
disk => 

IF boundStatus. status ¥ goodCompletion THEN (result <- ioError: GOTO Exit}; 
ENOCASE => Bug[1mpossible£ndcase]: 

-- Check Logical Root Page Label: 

IF volume = Volume.ID[1abel.f11elD,id] 

AND PilotDisk.GetLabelF11ePage[@label] = LogicalVolumeFormat.rootPageNumber 
AND ~label.temporary AND label.padl = 0 AND label.pad2 - 0 
AND label.type = PilotFileTypes.tLogicalVolumeRootPage 
THEN NULL ELSE (result *• badRootPageLabel ; GOTO Exit}; 

IF IvRoot.seal ¥ LogicalVolumeFormat.lvRootSeal THEN 
(result *■ trashedRootPage: GOTO Exit}; 

IF IvRoot.version ¥ LogicalVolumeFormat.currentVerslon THEN 
(result *■ otherVersion; GOTO Exit}; 
result *■ currentVersion; 

EXITS Exit => NULL 
END; 
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IvRoot «■ Space.Unmap[1vRoot]; 
END; 


END. 
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- •- AuthAImpl.mesa 

- -- JMaloney, 11 - Jul-83 12:24:49. 

- -- Last modified: JMaloney, 20- Jun- 84 11:16:36 


DIRECTORY 
Auth USING [ 

AuthenticationProblem, CallProblem, 

CheckOutCredsAndNextVerifier, CheckSimpleCredentials, 

ConversationHandle;CopyCredentials, Credentials, FetchStrongCredentials, 

Flavor, HashedPassword, HashSimplePassword, identityHandle, Key, 
nullCredentials, nullHostNumber, nullKey, 
nullVerifier, PasswordStringToKey. Verifier. whichArg] 

Authlnternal USING [ 

asStubHeap, CloneNSName, CloneNSString, CloneVerifier, 

ConversationObject, EquivalentNames, FreeCredentials, 

FreeNSName, FreeNSString, FreeVerifier, identityObject, 

IncrementVerifierTicks, InternalAuthenticate, 
lnternaiExtractCredentialsDetails,MakeEmptyNSName. 
MakeVerifierFromHashedPassword, MakeSimpleCredentials 
NilOrNullName, PackStrongVerifier, Style, UnpackStrongv/erifierj, 

AuthProtocol USING [StrongVerifier], 

AuthSpecial USING [], v, 

CH USING [ 

ConversationHandle, FreeCorjversationHandle, 

LookupDistinguishedName, ReturnCode], 

Courier USING [Error], 

DESFace USING [CheckKeyParity, Key, nullKey], 

Heap USING [Create, MakeNode], 

NSName USING [ 

CopyNameFields, maxDomainLength, maxLocalLength, maxOrgLength, Name], 
NSString USING [nullstring. String], 

NSStringExtras USING [EquivalentNames], 

Process USING [initiallzeMonitor, Pause, SecondsToTicks, Ticks], 

Router USING [AssIgnAddress], 

SharedKeys USING [asName, chsName, msName], 

SpecialCHAuth USING [], 

System USING [ 

GetClockPulses, GetGreenwichMeanTime, gmtEpoch, 

GreenwichMeanTime, HostNumber, NetworkAddress, 
nullHostNumber, SecondsSinceEpoch]; 

AuthAImpI: MONITOR 

LOCKS LOOPHOLE[identity, PrivateldentityHandle]' USING identity: Auth IdentityHandle 
IMPORTS 

Auth, Authlnternal, CH, Courier, DESFace, Heap, NSName, 

NSStringExtras, Process, Router, SharedKeys, System 
EXPORTS Auth, AuthSpecial, SpecialCHAuth 
SHARES Auth = 

BEGIN 


— Globals and constants — 


cacheConversations: BOOLEAN _ TRUE; 

conversationCacheTimeout: LONG CARDINAL = L0NG[12] * LONG(60] * lONG[60], 

— 12 hours, in seconds (half of the crentials lifetime). 

conversationHeap: UNCOUNTED ZONE_Heap.Create[initiai 4, increment 4], 

— All conversations and associated storage (creds, etc.) are allocated 

- - from this heap. We no longer use the clients heap. This was 

— because conversation caching made it possible for one 

- - client to lose storage owned by another. 

asStubHeap: UNCOUNTED ZONE = Authlnternal.asStubHeap; 

tlmesHaveHadToWaitForNextVerifier: CARDINAL __ 0; 

— This global is the number of times we've tried to create more than one 

- - verifier within a given second and run out of ticks since the last boot. 

- - it should be pretty small. 

thisfvlachinesAddress: System.NetworkAddress_ Router.AssignAddress[]; 


— Public errors — 

AuthenticationError: PUBLIC ERROR [reason: Auth.AuthenticatlonProblem] = CODE; 

CallError: PUBLIC ERROR [reason: Auth.CallProblem, whichArg: Auth.WhichArg] = CODE; 

OrphanConversatlon: PUBLIC ERROR - CODE; 

— This error is raised by Refresh only. 


- - Private errors — 


BadLineClock: PRIVATE ERROR = CODE; 

— Indicates that the line clock Is not advancing. 

— Should never happen unless your hardware is broken. 
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— identities — 


Makeldentity: PUBLIC PROC [ 

myName: NSName.Name, password; NSString.String, z: UNCOUNTED ZONE, 
style: Auth,Flavor, dontCheck: BOOLEAN] 

RETURNS {identity: Auth.ldentityHandle] = 

BEGIN 4 

newidentity: PrivateidentityHandle; 

newldentityz.NEW[Authlnternal.ldentityObject]; 
newldentity.style_style; 

newldentity.myName _ Authlnternal.MakeEmptyNSNamefz]; 

— Assume: newldentity.myName will be big enough to hold myName; 

— no heap will be needed by CopyNameFields. 

NSName.CopyNameFields[ 

z: NIL,source: myName,destination: newldentity.myName]; 

newidentity.myPassword_Authlnternal.CloneN$String[password, z], 

newldentity.myStrongKey _ PrivateKey[Auth.PasswordStringToKey [password]]; 

new Identity, my Hashed Password Auth.HashSimp!ePassword[password]; 

newldentity.nameHasBeenResolved_FALSE; 

newldentity.com/ersationsln Use NIL; 

newldentity.cachedConversations _ NIL; 

newldentity.owningHepp_z; 

Proces$.lnitializeMoni$r[@newldentity.LOCK]; 
identity _ Publicldentfnewldentity]; 

IF -dontCheck THEN SelfAuthenticatef 

identity ! UNWIND = > Freeldentity[@identity, NIL]]; - - No heap needed. 

END; 

MakeStrongldentity Using Key: PUBLIC PROC [ 

myName: NSName.Name, myKey: Auth.Key, z: UNCOUNTED ZONE, 
dontCheck: BOOLEAN] 

RETURNS {identity: Auth.ldentityHandle] = 

BEGIN 

IF -DESFace.CheckKeyParity{LOOPHOLE[LONG[@myKey]]] 

THEN ERROR CallError[badKey, notApplicable]; 
identity _ Makeldentity[myName, NSString.nullstring, z, strong, TRUE]; 

Privateldent[identity].myStrongKey_PrivateKey[myKey]; 

IF -dontCheck THEN SelfAuthenticatef 

identity ! UNWIND = > Freeldentity[@identity, NIL]]; — No heap needed. 

END; 

Freeldentity: PUBLIC PROC [ 

identityPtr: LONG POINTER TO Auth.ldentityHandle, z: UNCOUNTED ZONE] = 

— Note: z is no longer used. 

BEGIN 

CleanUpidentity: ENTRY PROC {identity: Auth.ldentityHandle] = 

BEGIN 

ENABLE UNWIND = > NULL; 
thisOne: PrivateConversationHandle; 

— Clean up currently active conversations (making them orphans): 

— (These conversations are in use; they should not be freed.) 

thisOne_Privateldent{identity].conversationslnUse; 

WHILE thisOne # NIL DO 

nextOne: PrivateConversationHandle _ thisOne.next; 

thisOne.owner_NIL; 

thisOne.next__NIL; 
thisOne _ nextOne; 

ENDLOOP; 

— Clean up cached conversations: 

— {These conversations are not in use; they should be freed.) 
thisOne _ Privateldent[identity].cachedConver$ations; 

WHILE thisOne# NIL DO 

nextOne: PrivateConversationHandle _thisOne.next; 
thisOne.owner _ NIL; - - Prevents monitor lock. 
lnternaiTerminate(LOOPHOLE[LONG{@thisOne]]]; 
thisOne __ nextOne; 

ENDLOOP; 

Authinternal.FreeNSName[ 

@Privateldent[identity].myName, Privateldent[identity].owningHeap]; 
Authlnternai.FreeN$String[ 

@Privateldent[identity].myPassword, Privateldent[identity].owningHeap]; 

END; 

IF identityPtr' = NIL THEN RETURN; 

CleanUpldentity[identityPtr']; 

— There is a tiny race here; we free the monitor lock before we 

— free the identity itself. This shouldn't matter; if the client 

— is calling Freeldentity, he'd better not be using it! 
Privateldent{identityPtr'].owningHeap.FREE[identityPtr]; 

— Smashes NIL into identityPtr'. 

END; 


— Conversations — 


Initiate: PUBLIC PROC { 

identity: Auth.ldentityHandle, recipientsName: NSName.Name, 
recipientsHostNumber: System.HostNumber __ Auth.nuliHostNumber, 
z: Ui^COUNTED ZONE] 

RETURNS {conversation: Auth.ConversationHandle] = 

-• - Note: z is no longer used. 

BEGIN 
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SELECT Authlnternal.Stylefidentity] FROM 
simple = > ResoiveNamelfAlias[identity]; 

strong = > CheckForValidName[Privateldent[identity].myName, strong]; 

ENDCASE = > ERROR; 

conversation __ lnternallnitiate[identity, recipientsName, recipientsHostNumberj; 

END; 

Terminate: PUBLIC PROC [ ~- 

conversationPtr: LONG POINTER TO Auth.ConversationHandle, z: UNCOUNTED ZONE] = 
BEGIN 

— Note: z is no longer used. 

InternalTerminatefconversationPtr, cacheConversations]; 

END; 

Refresh: PUBLIC PROC [conversation: Auth.ConversationHandle] = 

BEGIN 

MonitoredFetchStrongCredentials: ENTRY PROC [identity: Auth.ldentityHandle] = 

— If successful, sets values of newCreds and newConversationKey. 

— Assume: PrivateConv[conversation].owner = identity 
BEGIN 

ENABLE UNWIND = > NULL; 

[newCreds, newConversationKey] __ 

Auth.FetchStrongCredentialsf 

Privat/eConvfconversation]. owner. myName, 

PrivajjeConv[conversationj.recipient, 

PubliftKey[PrivateConv[conversation].owner.myStrongKey], 

PrivateConv[conversation].owningHeap]; 

END; 

newConversation Key: Auth. Key_Auth .null Key; 

newCreds; Auth.Credentials_Auth.nullCredentials; 

IF PrivateConv[conversation].owner = NIL THEN ERROR OrphanConversation; 

SELECT Authlntemal.$tyle[Publicldent[PrivateConv(conversation].owner]] FROM 

simple a > RETURN;-Noop 

strong = > 

MonitoredFetchStrongCredentials[Publiddent[PrivateConv[conversation]. owner]]; 
ENDCASE = > ERROR; 

— We fetched new credentials using the conversation's heap. We 

— may now free the old conversation credentials and replace them 

— with the one's we just fetched. 

Authlnternal.FreeCredentials[ 

@PrivateConv[conversation].creds, 

PrivateConv[conversation].owningHeap]; 

PrivateConv[conversation].creds _ newCreds; 

newCreds_Auth.nullCredentials; 

- - We've saved these credentials, so forget 'em. 
PrivateConv[conver$ation].conversation Key _ PrivateKey[newConversationKey]; 
PrivateConvfconversationj.clearLastVerifier 

_[System. GetGreenwichMeanTime[], GetRandomTicksForVerifier[]]; 

PrivateConv[conversation].creationTime_System. GetGreenwichMeanTime[]; 

END; 

CheckOutCredentials: PUBLIC PROC [conversation: Auth.ConversationHandle] 

RETURNS [creds; Auth.Credentials] = 

BEGIN 

RETURN[PrivateConv[conversation].cred$]; 

END; 

CheckOutNextVerifier: PUBLIC PROC [ 

conversation: Auth.ConversationHandle, recipientsHostNumber: System.HostNumber] 
RETURNS [verifier: Auth.Verifier] = 

BEGIN 

recipientsHostNumber __ 

IF recipientsHostNumber # System.nullHostNumber 
THEN recipientsHostNumber 
ELSE PrivateConv[conversation].recipientsHostNumber; 

RETURN[ 

ComputeNextVerifierForConversationf 

PrivateConv[conversation], 

recipientsHostNumber] 

]; 

END; 

CheckOutCredsAndNextVerifier: PUBLIC PROC [ 
conversation: Auth.ConversationHandle, 
recipientsHostNumber: System.HostNumber] 

RF.TURNS [creds: Auth.Credentials, verifier: Auth.Verifier] = 

BEGIN 

recipientsHostNumber _ 

IF recipientsHostNumber # System.nullHostNumber 
THEN recipientsHostNumber 

ELSE PrivateConv[conversationj.recipientsHostNumber; 

RETURNf 

PrivateConv[conversation].creds, 

ComputeNextVerifierForConversationf 

PrivateConvfconversation], 

recipientsHostNumber]]; 

END; 


— Serialization — 


- - NOTE: DescribeCredentialsand DescribeVerifier are 

— exported by AuthProtocolImpi. 
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- - Exports to AuthSpecial and SpecialCHAuth — 


- - AuthSpecial. — 

MakeNullCHConversation: PUBLIC PROC [z: UNCOUNTED ZONE] 

RETURNS [nullCHConv: ^H.ConversationHandle_[NIL, NIL]] = 

BEGIN 

nullConv: PrivateConversationHandle_ 

z.NEWfAuthlnternal.ConversationObject _ []]; 
nullConv.owningHeap_z; 

nullCHConv.conversation_PublicConv[nullConv]; 

END; 

— SpecialCHAuth. — 

MakeConversationFromCredsAndVerifier: PUBLIC ENTRY PROC [ 

identity: Auth.ldentityHandle, creds: Auth.Credentials, verifier: Auth.Verifier, 
z: UNCOUNTED ZONE] 

RETURNS [conversation: Auth.ConversationHandle] = 

— Note: z is no longer used. 

BEGIN 

ENABLE UNWIND = > NULL; 
newCortvprsation: PrivateConversationHandle; 
convKey$Auth.Key __ Auth.nuilKey; 
bad Creds}: BOOLEAN; 

SELECT creds.flavor FROM 
simple = > NULL; 
strong = > 

BEGIN 

— Assume: Privateldent[identity].style # simple 

[, convKey,,, badCreds,, ]_ 

Authlnternal.fnternalExtractCredentialsDetails[ 

PublicKey[Privateldent[identity].myStrongKey], creds, NIL, FALSE]; 

IF badCreds THEN ERROR AuthenticationError[credentialslnvalid]; 

END; 

ENDCASE => ERROR AuthenticationError(credentialslnvalid]; 

newConversation _conversationHeap.NEW[Authlnternal.ConversationObject]; 
newConversation.recipient __ NIL; 

— Assume: Noone will be interested in the recipient's name so why copy it? 

— NOTE: This is an orphan conversation. 

newConversation .creds _ Auth.CopyCredentials[creds, conversationHeap]; 

newConversation.lastVerifier_Auth.nullVerifier; — Filled in below. 

newConversation.conversationKey _ PrivateKeyfconvKey]; 
newConversation.incrementVerifierByTicks __ TRUE; 

newConversation.clearLastVerifier_[System.gmtEpoch, 0]; 

newConversation.recipientsHostNumber System. nuilHostNumber; 

newConversation.creationTime System. GetGreenwichMeanTimef]; 

newConversation.owner_NIL; 

newConversation.next_NIL; 

newConversation.owningHeap _ conversationHeap; 

SELECT creds.flavor FROM 
simple = > 

newConversation. lastVerifier_ 

Authlnternal.CloneVerifier[verifier, conversationHeap]; 
strong =3 > 

BEGIN 

ENABLE UNWIND = > 

lnternalTerminate[LOOPHOLE[LONG[@newConversation]]]; 

— No monitor problems because newConversation is an orphan. 

newConversation.dearLastVerifier_ 

Authlnternal.UnpackStrongVerifier[ 

verifier, PrivateKey[convKey], thisMachinesAddress.Host 
! Courier.Error = > ERROR AuthenticationError[verifierlnvalid]]; 
newConversation.lastVerifier _ 

DESCRIPTOR! 

Heap.MakeNodetconversationHeap, $IZE[AuthProtocol.StrongVerifier]], 
SIZE[AuthProtocoi.StrongVerifier]]; 

END; 

ENDCASE = > ERROR AuthenticationError[credentialslnvalid]; 

REiTU RN [Publ icConv[newConversation]]; 

END; 


— Private stuff — 


CheckForValidName: PROC [name: NSName.Name, style: Auth.Flavor] = 

- - Raises an error (according to style) if the name is NOT ok. 

BEGIN 

IF AuthInternal.NilOrNullName[name] OR 

name.local.Iength > NSName.maxLocailength OR 
name.domain.length > NSName.maxDomainLength OR 
name.org.length > NSName.maxOrgLength 
THEN ERROR CailErrorf 

(IF style a simple THEN simpleKeyDoesNotExist ELSE strongKeyDoesNotExist), 
not Applicable]; 

END; 

ComputeNextVerifierForConversation: PROC [ 
conversation: PrivateConversationHandle, 
recipientsHostNumber: System.HostNumber] 
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RETURNS [nextVerifier: Auth.Verifier) = 

- - This will compute a unique verifier later than last. If necessary, 

- - it will wait one second. If the timestamp in the verifier is greater than 

- - the current time (i.e. in the future), you're out of luck. It has the 

- - side effect of modifying the lastVerifier and clearlastVerifier fields 

- - of the conversation. 

BEGIN 

SELECT TRUE F£OM 

conversation'creds.flavor = simple = > RETURN[conversation.iastVerifier]; 
conversation.incrementVerifierByTicks = > — strong, strange case — 

BEGIN 

conversation.clearlastVerifier __ 

Authlnternal.lncrementVerifierTicks[conversation.clearLastVerifier]; 

Authlnternal.PackStrongVerifier[ 

from: @conversation.dearLastVerif!er, 
recipientsHostNumber: recipientsHostNumber, 
destVerifier: conversation.lastVerif ier, 
key: conversation.conversationKey]; 

END; 

ENDCASE = > — strong, normal case — 

BEGIN 

last: AuthProtocol.StrongVerifier __conversation.clearlastVerifier; 
timeOfLastVerifier, timeOfNextVerifier: LONG CARDINAL; 
v, oneSecond: Process.Ticks _ Process.SecondsToTicks[1]; 

next: AuthProtocol.StrongVerifier_[ 

? timestamp: System.GetGreenwichMeanTimel], 
ticks: GetRandomTicksForVerifier(]]; 
timeOfLastVerifier __ System.SecondsSinceEpoch[last.timeStamp]; 
timeOfNextVerifier _ System. $econdsSinceEpoch{next.time$tamp]; 

IF -(timeOfNextVerifier > timeOfLastVerifier) THEN 
BEGIN 

IF timeOfNextVerifier < timeOfLastVerifier THEN ERROR BadLineClock; 
— Time appears to be going backwards! I! 

— If we get this far, timeOfNextVerifier = timeOfLastVerifier. Since 

— we can't make duplicate verifiers, we've got to increment the ticks 

— or, if we've run out of ticks in a LONG CARDINAL, then we've got 

— to wait until the next second. (This should be VERY rare.) 

IF last.ticks # LAST[LONG CARDINAL] 

THEN next.ticks_last.ticks + 1 

ELSE 

BEGIN 

Process.Pause[oneSecond]; 

timesHaveHadToWaitForNextVerifier_ 

timesHaveHadToWaitForNextVerifier +■ 1; 
next_[ 

timestamp: System.GetGreenwichMeanTime[], 
ticks: GetRandomTlcksForVerifier[]]; 

IF System.SecondsSinceEpoch[next.timeStamp] < = 
timeOfLastVerifier 

THEN ERROR BadLineClock; 

— If, after pausing for a second, the clock 

— hasn't advanced, something must be wrong 

— with the dock... 

END; 

END; 

conversation.clearLastVerifier _ next; 

Authlnternal.PackStrongVerifier[ 

from: @conversation.ciearla$tVerifier, 
recipientsHostNumber: recipientsHostNumber, 
destVerifier: conversation .lastVerif ier, 
key: conversation.conversationKey]; 

END; 

RETURN[conversation.lastVerffier]; 

END; 

GetConversationFromCache: INTERNAL PROC [ 

id: F‘rivateldentltyHandle, recipient: NSName.Name] 

RETURNS [conv: PrivateConversationHandle_NIL] = 

BEGIN 

FindConversationFor: PROC [name: NSName.Name] 

RETURNS [convFound: PrivateConversationHandle] = 

BEGIN 

previous: LONG POINTER TO PrivateConversationHandle; 

IF Authlnternal.NilOrNullName(name] THEN RETURN[NIL]; 

- - Find the conversation (if any) preceding the one 

- we'd like to use. 

previous_@id.cachedConversations; 

WHILE previous" # NIL DO - - For entire list, do: 

IF NSStrfngExtras.EquivalentNamesfprevious".recipient, name] 

THEN EXIT; - - Found one! 
previous _ ©previous" .next; 

ENDLOQP; 

IF previous" = NIL THEN RETURN[NIL]; - - Didn't find one. 

— Found one, splice it out: 
convFound __ previous"; 
previous" _convFound.next; 

- - Put it on the front of the list of conversations in use: 

convFound.next _ id.conversationslnUse; 

id.conver$ationsinUse_convFound; 

RETURN[convFound]; 

END; 

VVeedOutOldConversations: PROC = 

BEGIN 

previous: LONG POINTER TO PrivateConversationHandle _ 

@id .cachedConversations; 

convToRemove: PrivateConversationHandle_NIL; 

— Seek out and destroy all old conversations: 
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while previous' # NIL 00 — For entire list, do 
SELECT OldConver$ation[previous’] FROM 
FALSE = > 

BEGIN 

previous_©previous'.next; 

LOOP; — This is a young entry; pass over it. 

END; 

v TRUE = > 

^ BEGIN 

convToRemove_previous'; 

- Splice this conversation out of list: 

previous' previous'.next; 

— Kill it: 

convToRemove.owner_NIL; 

lnternalTerminate[LOOPHOLE[LONG(@convToRemove]]]; 

END; 

ENDCASE; 

ENDLOOP; 

END; 

WeedOutOldConversationsf]; 

RETU RN [FindConversationFor[recipient]]; 

- END; 

^etRandomTicksForVerifier: PROC RETURNS [ticks: LONG CARDINAL) - 
} BEGIN 

ticks_System.GetClockPulses[); 

IF ticks > 10000 THEN ticks __ ticks - 10000; 

- - This makes sure that ticks is within [O..MAX[LONG CARDINAL) - 10000). 

— That way, we can make up to 10000 verifiers within a given second 

— by incrementing the ticks field. 

END; 

Internallnitiate: PRIVATE ENTRY PROC ( 

identity: Auth.ldentityHandie, recipientsName: NSName.Name, 
recipientsHostNumber: System.HostNumber __ Auth.nullHostNumber) 

RETURNS [conversation: Auth.ConversationHandle] = 

BEGIN 

ENABLE UNWIND = > NULL; 
newConversation: PrivateConversationHandle; 
newCreds: Auth.Credentials; 
newConversation Key: Auth.Key_Auth.nuIlKey; 

newConversation_ 

GetConversationFromCache[Privateldent[identity], recipientsName); 

IF newConversation # NIL THEN 

BEGIN — if there was a conversation in the cache, use it! 
newConversation.recipientsHostN umber _ recipientsHostNumber; 
RETURN[PublicConv[newConversation]J; 

END; 

-• - No credentials in the cache, so manufacture or fetch some: 

SELECT Privateldent[identity).style FROM 
simple a > 
newCreds_ 

Authlnternal.MakeSimpleCredentiais[ 

Privateldent[identity).myName, conversationHeap]; 
strong = > 

[newCreds, newConversation Key) _ 

Auth.FetchStrongCredentialsf 

Privateldent[identity].myName, recipientsName, 
PublicKey[Privateldent[identity).myStrongKey], conversationHeap); 
ENDCASE = > ERROR; 

newConversation_conversationHeap.NEW[Authlnterna!.ConversationObject); 

newConversation.recipient _ 

Authlnternal.CloneNSName[recipientsName, conversationHeap); 
newConversation. creds newCreds; 

newConversation.lastVerifier _ Auth.nuilVerifier; — Filled in below. 

newConversation.conversationKey_PrivateKeyfnewConversationKey); 

newConversation.incrementVerifierByTicks_FALSE; 

newConversation.dearLastVerifier_ 

[System.GetGreenwichMeanTimeJ), GetRandomTicksForVerifierf)]; 

newConversation.recipientsHostNumber_recipientsHostNumber; 

newConversation.creationTime_System.GetGreenwichMeanTime[); 

newConversation.owner_NIL; 

newConversation.next_NIL; 

newConversation.owningHeap_conversationHeap; 

SELECT TRUE FROM 

newConversation.creds = Auth.nullCredentials =* > 

newConversation.lastVerifier_Auth.nuilVerifier; 

Privateldent[identity].style = simple = > 

newConversation.lastVerifier_ 

Authlnternal.MakeVerifierFromHashedPassword[ 

Privat.eldent[identity].myHashedPassword, conversationHeap); 
Privateldent[identity).style = strong - > 

newConversation.lastVerifier_ 

DESCRIPTOR! 

Heap.MakeNodefconversationHeap, SlZE[AuthProtocol.StrongVerifier)], 
SIZE[AuthProtocoi.StrongVerifier]]; 

ENDCASE = > ERROR; 

— Put on front of identity’s list of conversations in use: 
newConversation.owner _ Privateldent[identity); 

newConversation.next_Privateident[identity].conversationslnUse; 

Privateldent[identity].conversationslnUse _ newConversation; 
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RETURN[PublicConv[newConversation]]; 

END; 

InternalTerminate: PROC[ 

conversationPtr: LONG POINTER TO Auth.ConversationHandle, 
okToCache: BOOLEAN _ FALSE] = 

BEGIN 

RgmoveConvFromldentity: ENTRY PROC [identity; Auth.ldentityHandle] = 

— Removes conversationPtr" from identity.conversations^Use. 

'.'BEGIN 

ENABLE UNWIND - > NULL; 

— Assume: identity = PrivateConv[conversationPtr"].owner 
— Assume: identity #NIL 

previous: LONG POINTER TO PrivateConversationHandle _ 
@Privateldent[identity].conversationslnUse; 

- - Find previous conversation in chain: 

DO 

IF previous' = PrivateConv[conversationPtr“] THEN EXIT; 

IF previous" = NIL THEN ERROR; 

— A conversation has an owner that doesn't know about 

— the conversation. This "can't" happen (if it does there 

— is a bug in this code somewhere, 

previous_@previous".next; 

ENDLOOP; 

-- - Splice out this conversation: 

previous"_PrivateConv[conver$ationPtr"].next; 

PrivateConv[conver$ationPtr"].next_NIL; 

END; 

OfferConvToldentityCache: ENTRY PROC[ 

identity: Auth.ldentityHandle, conversation: PrivateConversationHandie] 
RETURNS [accepted: BOOLEAN _ FALSE] = 

— This operation may add conversation to identity.cachedConversations. 

— If it does, accepted will be set to TRUE. 

BEGIN 

ENABLE UNWIND = > NULL; 

IF -okToCache 

OR conversation.incrementVerifierByTicks 
OR OldConversation[conversation] 

OR Auth internal.NilOrNullName{conversation.recipient] 

THEN RETURN [accepted: FALSE]; 

conversation, next_Privateldent[identity].cachedConversations; 

Privateldent(identity].cachedConversations_conversation; 

RETURN[accepted: TRUE]; 

END; 

addedToCache: BOOLEAN; 

IF conversationPtr" = NIL THEN RETURN; — Nothing to do. 

IF PrivateConv[conversationPtr"].owner #NIL THEN 
BEGIN 

RemoveConvFromldentity[Publiddent[PrivateConv[conversationPtr"J.owner]]; 

addedToCache_ 

OfferConvToldentityCachel 

Pub!ictdent[PrivateConv[conversationPtr'].owner], 

PrivateConv[conversationPtr"]]; 

IF addedToCache 

THEN {conversationPtr"_NIL; RETURN}; 

— Do NOT free the conversation; do set it to NIL. 

END; 

— Free the conversation: 

Authlnternal.FreeNSName] 

@PrivateConv[conversationPtr"].recipient, 
PrivateConv[conversationPtr"].owningHeap]; 

Authlnternai.FreeCredentials] 

@PrivateConv[conversationPtr'].creds, 

PrivateConv[conver$ationPtr‘].owningHeap]; 

Authlnternal.FreeVerifier( 

@PrivateConv[conversatIonPtr"].la$tVerifier, 

PrivateConv[conversationPtr" J.owni ng Heap]; 
PrivateConv[conversationPtr"].owningHeap.FREE[eonversationPtr]; 

- - Smashes NIL into conversationPtr". 

END; 

IsWellKnownName: PROC [name: NSName.Name] 

RETURNS [isWellKnown: BOOLEAN] = 

BEGIN 
RETURN[ 

Authlnternal.EquivalentNames[name, SharedKeys.asName] OR 
Authlnternal.Equiva!entNames(name, SharedKeys.chsName] OR 
Authl nternal.EquivalentNames[name, SharedKeys.msName] 


END; 

MakeSimpleCHOrphanConversation: PROC [ 

for: NSName.Name, hashedPassword: Auth.HashedPassword] 

RETURNS [chConv: CH.ConversationHandle] = 

BEGIN 

chConv _ MakeNullCHConversatlon[asStubHeap]; 

PrivateConv[chConv.conversation].creds_ 

Authlnternai.MakeSimpieCredentia!s[for, asStubHeap]; 
PrivateConv[chConv.conversation].lastVerifier _ 

Authlnternal.MakeVerifierFromHashedPassword[hashedPassword, asStubHeap]; 

END; 

OldConversation: PROC [conv: PrivateConversationHandle] 

RETURNS [isOld: BOOLEAN] = 
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BEGIN 

now: LONG CARDINAL __ 

System.SecondsSinceEpoch[System.GetGreenwichMeanTime[]]; 

then: LONG CARDINAL _ 

System.SecondsSinceEpoch[conv.creationTirne]; 

IF then > now 

THEN (sOld_TRUE 

L - - Clock is running backward?? Consider the conversation "old". 

ELSE isOld__((now - then) > conversationCacheTimeout); 

'' END; 

ResolveNamelfAlias: ENTRY PROC [identity: Auth.ldentityHandle] = 

- - Assume: This operation gets called only with a simple identity. 

BEGIN 
ENABLE { 

AuthenticationError = > ERROR CaliError[badKey, initiator]; 
UNWIND = > NULL; 

}; 


chConversation: CH.ConversationHandle_[NIL, NIL]; 

distingName: NSName.Name_NIL; 

rc: CH.ReturnCode; 

•'/ IF Privateldent[identity].nameHasBeenResolved THEN RETURN; 

If CheckForValidName[Privateldent[identity].myName, Privateldentfidentityj.stylej; 

! IF lsWelfKnownName[Privateldent[ldentity].myName] THEN 

BEGIN 

Privateldent[identity].nameHasBeenResolved _ TRUE; 

RETURN; 

END; 

chConversation_MakeSimpleCHOrphanConversationf 

Privateldent[identity].myName, Privateldent[identity].myHashedPassword]; 
distingName _ Authlnternal.MakeEmptyNSName[asStubHeap]; 

BEGIN 

ENABLE UNWIND = > { 

CH.FreeConversationHandle[@chConversation, NIL]; 
Authlnternal.FreeNSName[@distingName, asStubHeap]; 

rc_CH.LookupDistingui$hedName[ 

chConversation, Privateldent[identity].myName, distingName]; 

SELECT rc.code FROM 
done = > 

BEGIN 

— Assume: Privateldent[identity].myName is big enough; 

— no heap will be needed by CopyNameFields. 
NSName.CopyNameFields[ 
z: NIL, source: distingName, 
destination: Privatetdentfidentity].myName]; 
Privateldent[identity].nameHasBeenResolved __ TRUE; 

END; 

noSuchOrg, noSuchDomain, noSuchLocal, 
illegalOrgName, illegalDomalnName, illegalLocalName = > 

ERROR CallError[simpleKeyDoesNotExi$t, initiator]; 
rejectedTooBusy = > 

ERROR CallError[tooBusy, not Applicable); 
allDown = > 

ERROR CaliError[keysUnavailable, initiator]; 
credentialslnvalid = > 

ERROR Call£rror[badKey, initiator]; 

ENDCASE = > ERROR CailError[simpleKeyDoesNotExist, initiator]; 
Authlnternal.FreeNSName[@distingName, asStubHeap]; 

END; 

CH.FreeConversationHandle(@chConversation, NIL]; 

END; 

Self Authenticate: PROC [identity: Auth.ldentityHandle] = 

- - This operation will also resolve the name in the identity handle. 

- - Assume: This procedure is only called from an identity creation procedure! 

BEGIN 

creds: Auth.Credentials _ Auth.nuNCredentials; 
verifier: Auth.Verifier _ Auth.nullVerifier; 
conv: Auth.ConversationHandte __ NIL; 

SELECT Privateldent[identityJ.sty!e FROM 
simple = > 

Re5oiveNamelfAlias[ldentity]; 
strong = > 

CheckForVaIidName[Privateldent[identity]. myName, strong]; 

- - Note: Since the strong credentials produced by the AS always contain 

— a distinguished name, we save a Clearinghouse operation by extracting 

- - the disinguished name from the credentials that we are using to check 

— this identity. 

ENDCASE = > ERROR; 

SELECT Privatetdent[identitv].style FROM 
simple = > 

BEGIN 

ENABLE UNWIND =s > lnternalTerminate[@conv]; 

conv _ internaltnitiatefidentity, Private!dent[identity].myName]; 

[creds, verifier] _Auth.CheckOutCredsAndNextVerifier[conv]; 

IF ~Auth.CheckSimpleCredentials[creds, verifier].ok 
THEN ERROR CallError[badKey, notApplicable]; 
lnternalTerminate[@conv]; 

END; 
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strang = > 

BEGIN 

ENABLE UNWIND = > lnternalTerminate[@conv]; 
distingName: NSName.Name_NIL; 

conv _ lnternallnitiate[identity, Privateldent[identity].myName]; 

[creds, verifier]_ 

CheckOutCredsAndNextVerifier[conv, thisMachinesAddress.host]; 

— To get the distinguished name for strong credentials, do an 
— Authenticate, which returns the distinguished name (which was 

- - resolved by the server). Replace the identity.myName with this name. 

[distingName,, ]_Authlnternal,lnternalAuthenticate[ 

PublicKey[Privateldent(identity].myStrongKey], creds, verifier, 
asStubHeap, thisMachinesAddress.host, 

FALSE, FALSE, TRUE, FALSE 

! AuthenticationError = > ERROR CallErrorfbadKey, notApplicable]]; 

— Assume: Privateldent[identity].myName is big enough; 

— no heap will be needed by CopyNameFields. 

NSName.CopyNameField$[ 

z: NIL, source: distingName, destination: Private!dent[identity].myName]; 
Authlnternai.FreeNSName[@distingName, asStubHeap]; 

Privateldent[identity].nameHasBeenResolved_TRUE; 

lnternalTerminate[@convj; 

END; 

ENDCASE = > ERROR; 

END; 


— Public/Private pointer conversions — 


— Note: This is a hack to avoid exporting public types. 

— (Because exported type clashes make it impossible for two 

— different implementations which export the same type to co - exist.) 

PrivateldentityHandle: TYPE = LONG POINTER TO Authlnternal.ldentityObject; 

PrivateConversationHandle: TYPE = LONG POINTER TO Authlnternal.ConversationObject; 

PrivateConv: PROC [conversation: Auth.ConversationHandie] 

RETURNS [PrivateConversationHandle] = INLINE 
{RETURN[LOOPHOLE[conversation]]>; 

PublicConv: PROC [privateConversation: PrivateConversationHandle] 

RETURNS [Auth.ConversationHandie] = INLINE 
{RETURN[LOOPHOLE[privateConversation]]}; 

Privatetdent: PROC [identity: Auth.ldentityHandle] 

RETURNS [PrivateldentityHandle] = INLINE 
{RETURN[LOOPHOLE[identity]]>; 

Publiddent: PROC [privateldentity: PrivateldentityHandle] 

RETURNS [Auth.ldentityHandle] = INLINE 
{RETURN[LOOPHOLE[privateldentity]]}; 

PrivateKey: PROC [key: Auth.Key] 

RETURNS [DESFace.Key] = INLINE 
(RETURN[LOOPHOLE[key]]}; 

PublicKey: PROC [privateKey: DESFace.Key] 

RETURNS [Auth.Key] = INLINE 

{RETURN [LOOPHOLE[privateKey]]}; 


END. 
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- AuthClmpl.mesa 

- - JMaloney, 11 -Jul-83 12:24:49. 

- - Last modified: JMaloney, 3-Jul-84 12:00:10. 


DIRECTORY 
Auth USING [ 

AuthentrcationError, CallError, CallProblem, 

CheckOutCredsAndNextVerifier, ConversationHandle, 

Credentials, Flavor, HashedPassword, HashSimplePassword, 

IdentityHandle, Initiate, Key, nuliCredentials, 
nullHashedPassword, nuIlKey, nullVerifier, 

PasswordStringToKey, Terminate, Verifier, WhichArg], 

Authlnternal USING [ 

asStubHeap, BadCredentialsPackage, CloneNSString, 

ConversationObject, ExtractStuffFromCredentialsPackage, FreeNSString, 
FreeSimpleCredentials, IdentityObject, 

Style, UnpackSimpleCredentials], 

AuthOps USING [ 

ChangeSimpleKey, ChangeStrongKey, 

CreateSimpleKey, CreateStrongKey, 

DeleteSimpleKey, DeleteStrongKey, 

CheckSimpleCredentials, GetStrongCredentials], 

AuthProtocol USING [ 

CredentialsPackage, DescribeCredentialsPackage, SimpleCredentials], 
AuthServerCache USING [ASAddress, NextPlease, Refill], 

Courier USING [Description, Error, Free], 

DESFace USING [Block, CheckKeyParity, EncryptBlock, Key, nuIlKey], 

NSName USING [Name], 

NSString USING [String], 

Process USING [MsecToTicks, Pause, Ticks], 

SharedKeys USING [asNamej, 

System USING [GetClockPulses, NetworkAddress, nuilNetworkAddress]; 

AuthClmpI: MONITOR 

LOCKS LOOPHOLE[identity, PrivateldentityHandle] 1 ' USING identity: Auth.IdentityHandle 
IMPORTS 

Auth, Authlnternal, AuthProtocol, AuthOps, AuthServerCache, Courier, 

DESFace, Process, SharedKeys, System 
EXPORTS Auth 
SHARES Auth = 

BEGIN 


— Globafs and constants — 


cacheNeverFilled: BOOLEAN _TRUE; 

pauseForlnitialCacheFtil: Process.Ticks_ Process.MsecToTicks[15000]; 

— fifteen seconds 

timesToRetry: CARDINAL_1; 

— - The number of times to grab a new address out of the cache and re - try 

— an operation which must talk to an AS. 


— Password/Key administration operations — 


ChangeMyPasswords: PUBLIC PROC [ 

identity: Auth.ldentityHandle, newPassword: NSString.String, z: UNCOUNTED ZONE, 

changeStrong, changeSimple: BOOLEAN] a 

BEGIN 

ComputeOIdKeyValues: ENTRY PROC [identity: Auth.ldentityHandle] 

RETURNS [oldStrongValue: Auth.Key, oldSimpleValue: Auth.HashedPassword] = 

- - Computes oldStrongValue and oldSimpleValue from password 

— in identity handle. 

BEGIN 

ENABLE UNWIND = > NULL; 
oldStrongValue_ 

Auth.PasswordStringToKey[Privateldent[identity].myPassword]; 
oldSimpleValue_ 

Auth.HashSimplePassword[Privateldent[identity].myPa$sword]; 

END; 

Changeldentitylnfo: ENTRY PROC [identity: Auth.ldentityHandle] = 

— Fix up the password info in the identity. 

BEGIN 

ENABLE UNWIND a > NULL; 

Authlnternal.FreeNSString[ 

@Privateldent[identity].myPassword, Privateldentfidentityj.owningHeap]; 
Privateldent[identity].myPassword_ 

Authlnternal.CloneNSString[newPassword, Privateldent[identity].owningHeap]; 
IF changeStrong 

THEN Privateldent[identity].myStrongKey _ PrivateKey[newStrongKey]; 

IF changeSimple 

THEN Privateldentfidentityj.myHashedPassword _ newHashedPassword; 

END; 

newStrongKey: Auth.Key _ Auth.PasswordStringToKey[newPassword); 
newHashedPassword: Auth.HashedPassword _ 

Auth. HashSi mpl ePassword [newPassword]; 

IF changeStrong THEN ChangeStrong Key [identity, newStrongKey]; 

IF changeSimple THEN 
BEGIN 
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ENABLE UNWIND = > { 

— Undo what we have done so far... 

oldStrongKey: Auth.Key _ Auth.nuIlKey; 

oldSimpleKey: Auth.HashedPassword __Auth.nullHashedPas$word; 

[oldStrongKey, oldSimpleKey]_ComputeOldKeyValue$[identityj; 

IF changeStrong THEN 
ChangeStrongKey[ 
identity, oldStrongKey 

! Auth.AuthenticationError, Auth.CallError = > CONTINUE]; 
ChangeSimpleKeyt 
identity, oldSimpleKey 

! Auth.AuthenticationError, Auth.CallError = > CONTINUE]; 

}; 

ChangeSimpleKeylidentity, newHashedPassword]; 

END; 

— if we got this far it worked; we can fix up identityObject. 
Changeldentitylnfofidentity]; 

END; 

CreateStrongKey: PUBLIC PROC [ 

identity: Auth.ldentityHandle, name: NSName.Name, newStrongKey: Auth.Key] = 
BEGIN 

Dolt: PROC [ 

creds: Auth.Credentials, verifier: Auth.Verifier, conv: Auth.ConversationHandle, 
asAddressPtr: LONG POINTER TO System.NetworkAddress] = 

BEGIN 

encryptedlnitlalKey: DESFace.Block; 

DESFace.EncryptBlock[ 
key: PrivateConv[conv].conversationKey, 

from: LOOPHOLE[LONG[@newStrongKey]], to: @encryptedlnitialKey]; 
AuthOps.CreateStrongKeyj 

creds, verifier, name,encryptedlnitialKey, asAddressPtr]; 

END; 

SELECT Authlnternal.Style[identity] FROM 

simple = > ERROR Auth.AuthenticationErrorfinappropriateCredentiais]; 
strong = > ConverseWithASAndCallMe[identity, name. Dolt]; 

ENDCASE = > ERROR; 

END; 

ChangeStrongKey: PUBLIC PROC [ 

identity: Auth.ldentityHandle, newStrongKey: Auth.Key] = 

BEGIN 

Changeldentitylnfo: ENTRY PROC [identity: Auth.ldentityHandle] = 

BEGIN 

ENABLE UNWIND = > NULL; 

Authlnternal.FreeNSString[ 

@Privateldent[identity].myPassword, Privateldent[identity].owningHeap]; 
— Leave password a nullstring because it is no longer related to 
— the "truth" in identity.myStrongKey. 

Privateldent[f'dentity].myStrongKey _ PrivateKeyfnewStrongKey]; 

END; 

Dolt: PROC [ 

creds: Auth.Credentials, verifier: Auth.Verifier, conv: Auth.ConversationHandle, 
asAddressPtr: LONG POINTER TO System.NetworkAddress] = 

BEGIN 

encryptedNewKey: DESFace.Block; 

DESFace.EncryptBlock[ 
key: PrivateConv[conv].conversationKey, 

from: LOOPHOLE[LONG[@newStrongKey]], to: @encryptedNewKey]; 
AuthOps.ChangeStrongKeyfcreds, verifier, encryptedNewKey, asAddressPtr]; 
END; 

SELECT Auth!nternaf.Style[identity] FROM 
simple = > ERROR Auth.AuthenticationErrorfinappropriateCredentiais]; 
strong = > 

ConverseWithASAndCallMefidentity, Privateldent[identity].myName, Dolt]; 
ENDCASE a > ERROR; 

- - if we got this far it worked; we can fix up identityObject. 
Changeldentitylnfo[identity]; 

END; 

DeleteStrongKey: PUBLIC PROC [identity: Auth.ldentityHandle, name: NSName.Name] = 
BEGIN 

Dolt: PROC [ 

creds: Auth.Credentials, verifier: Auth.Verifier, conv: Auth.ConversationHandle, 
asAddressPtr: LONG POINTER TO System.NetworkAddress] = 

BEGIN 

AuthOps.DeleteStrongKey[creds, verifier, name, asAddressPtr]; 

END; 

SELECT Authlnternal.Style[identity] FROM 
simple = > ERROR Auth.AuthenticationError(inappropriateCredentials]; 
strong = > ConverseWithASAndCailMefidentity, name, Dolt]; 

ENDCASE = > ERROR; 

END; 

Crea teSimpleKey: PUBLIC PROC [ 

identity: Auth.ldentityHandle, name: NSName.Name, 
newSimpleKey: Auth.HashedPassword] =* 

BEGIN 

Dolt: PROC [ 

creds: Auth.Credentials, verifier: Auth.Verifier, conv: Auth.ConversationHandle, 
asAddressPtr: LONG POINTER TO System.NetworkAddress] = 
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BEGIN 

AuthOps.CreateSimpleKey( 
creds, verifier, name, newSimpleKey, asAddressPtr]; 

END; 

ConverseWithASAndCalIMe[identity, name. Dolt]; 

END; 

ChangeSimpleKey; PUBLIC PROC [ 

identity: Auth.ldentityHandle, newSimpleKey: Auth.HashedPassword] = 

BEGIN 

Changeldentitylnfo: ENTRY PROC [identity: Auth.ldentityHandle] = 

BEGIN 

ENABLE UNWIND = > NULL; 

Auth!nternal.FreeNSString[ 

@Privateldent[identity].myPassword, Privateldent[identity].owningHeap); 

- - Leave password a nullstring because it is no longer related to 

- - the “truth" in identity.myHashedPassword. 

Privateldent[identity].myHashedPassword_newSimpleKey, 

END; 

Dolt: PROC [ 

creds: Auth.Credentials, verifier: Auth.Verifier, conv: Auth.ConversationHandle, 
asAddressPtr: LONG POINTER TO System.NetworkAddress] = 

BEGIN 

AuthOps.ChangeSimpleKey[creds, verifier, newSimpleKey, asAddressPtrl; 
END; 

ConverseWithASAndCallMe[identity, Privatetdent[identity].myName, Doltl; 

— if we got this far it worked; we can fix up identityObject. 
Changeldentitytnfo[identity]; 

END; 

DeleteSimpleKey: PUBLIC PROC [identity: Auth.ldentityHandle, name; NSName.Name] = 
BEGIN 

Dolt: PROC [ 

creds: Auth.Credentials, verifier: Auth.Verifier, conv: Auth.ConversationHandle, 
asAddressPtr: LONG POINTER TO System.NetworkAddress] = 

BEGIN 

AuthOp$.DeleteSimpleKey[creds, verifier, name, asAddressPtr]; 

END; 

ConverseWithASAndCallMefidentity, name, Dolt]; 

END; 


— Credentials operations which call the server — 


CheckSimpleCredentials: PUBLIC PROC [ 

creds: Auth.Credentials, verifier: Auth.Verifier] 

RETURNS [Ok: BOOLEAN _ FALSE] = 

BEGIN 

Dolt: PROC [asAddressPtr: LONG POINTER TO System.NetworkAddress] = 

BEGIN 

ok _ AuthOps.CheckSimpleCredentials[creds, verifier, asAddressPtr]; 

END; 

IF creds.flavor # simple 

THEN ERROR Auth.AuthenticationError[credentialslnvalid]; 

BEGIN 

simpleCreds: AuthProtocol.SimpleCredentiais _ 
Authlnternal.UnpackSimpleCredentiais[ 
creds, Authlnternal.asStubHeap 

! Courier.Error = > ERROR Auth.AuthenticationError[credentialslnvalid]]; 

— The followi ng calls the AS and sets ok: 

ContactASAndCaiiMef 
Dolt, simpleCreds.initiator 
•UNWIND = > 

Authlnternal.FreeSimpleCredentials[@simpleCreds, Authlnternal.asStubHeapl]; 
Authlnternal.Free$impleCredentiais[@$impleCreds, Authlnternal.asStubHeap]; 

END; 

END; 

FetchStrongCredentials: PUBLIC PROC [ 
initiator, recipient: NSName.Name, 
initiatorsStrongKey: Auth.Key, z: UNCOUNTED ZONE] 

RETURNS [creds: Auth.Credentials, conversation Key: Auth.Key] = 

BEGIN 

Dolt: PROC [asAddressPtr: LONG POINTER TO System.NetworkAddress] = 

BEGIN 

credentialsPackage _ 

AuthOps.GetStrongCredentials[initiator, recipient, nonce, asAddressPtr]; 

END; 

convKey: DESFace.Key __ DESFace.nullKey; 
credentialsPackage: AuthProtocol.CredentialsPackage; 

nonce: LONG CARDINAL_System.GetOockPulsesf]; 

SELECT TRUE FROM 

initiator = NIL = > ERROR Auth.CallError[strongKeyDoesNotExist, initiator]; 
recipient = NIL =s > ERROR Auth.CallError[strongKeyDoesNotExist, recipient]; 
ENDCASE; 

ContactASAndCallMe[Dolt, initiator]; - - fills in credentialsPackage 
BEGIN 

ENABLE UNWIND = > Courier.Freef 

[@credentialsPackage, AuthProtocol.DescribeCredentiaisPackage], 
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Authlnternal.asStubHeap]; 


[creds, convKey]_ 

Authlnternal.ExtractStuffFromCredentialsPackage[ 
credentiaisPackage, PrivateKey[initiators$trongKey], 
recipient, nonce, z 

I Authlnternal.BadCredentialsPackage = > 

ERROR Auth.CaliErrorfbadKey, notApplicablel]; 

IF -DESFace.CheckKeyParity(@convKey] 

THEN ERROR Auth.CallError[badKey, notApplicablej; 

END; 

Courier.Free[ 

[@credentialsPackage, AuthProtocol.DescribeCredentialsPackage], 
Authlnternal.asStubHeap]; 

RETURN[creds, PublicKey[convKey]]; 

END; 


— Private stuff — 


ConverseWithASAndCalfMe: PROC [ 

identity: Auth.ldentityHandle, nameHint: NSName.Name, 
procToCall: PROC [ 

Auth.Credentials, Auth.Verifier, Auth.ConversationHandle, 

LONG POINTER TO System.NetworkAddress]] = 

BEGIN 

retrys: CARDINAL _0; 

asAddress: System.NetworkAddress_System.nullNetworkAddress; 

creds: Auth,Credentials _ Auth.nullCredentials; 

verifier: Auth.Verifier_Auth.nullVerifier; 

conv: Auth.ConversationHandle; 

conv_Auth.lnitiate[identity, SharedKeys.asName,, Authlnternal.asStubHeap); 

asAddress ___ AuthServerCache.ASAddressfnameHint]; 

BEGIN 

ENA8LE UNWIND = > Auth.Terminate[@conv, Authlnternal.asStubHeap]; 

DO 

[creds, verifier] __ Auth.CheckOutCredsAndNextVerif ierfconv, asAddress.host); 
procToCall[ 

creds, verifier, conv, @asAddress 
! Auth.CallError = > 

IF (reason 3 cannotReachAS OR reason = tooBusy)AND 
retrys < timesToRetry 
THEN 
BEGIN 

addressesleftInCaehe: CARDINAL _ 
AuthServerCache.NextPleaselasAddress]; 
AuthServerCache.Refill(]; 

asAddress_AuthServerCache.ASAddress[); 

retrys _ retrys +• 1; 

LOOP; 

END; 

Auth.Authentication Error = > 

— The reason must be credentialslnvalid; this is highly unusual! 
(ERROR Auth.CallError[badKey, notApplicablej}; 

I; 

EXIT; — Successful call 
ENDLOOP; 

END; 

Auth.Terminatef@conv, Authlnternal.asStubHeap]; 

END; 

ContactASAndCallMe: PROC [ 

procToCall: PROC [LONG POINTER TO System.NetworkAddress], 
nameHint: NSName.Name] = 

BEGIN 

retrys: CARDINAL _0; 

asAddress: System.NetworkAddress_AuthServerCache.ASAddress[nameHint]; 

IF cacheNeverFilled THEN 
BEGIN 

AuthServerCache.RefillU; 
cacheNeverFilled _ FALSE; 

IF asAddress = System.nullNetworkAddress THEN 
BEGIN 

Process.PausetpauseForlnitlalCacheFillj; — Wait only if we have to. 

asAddress_AuthServerCache.ASAddressf]; 

END; 

END; 

DO 

procToCall [ 

@asAddress 
! Auth.CallError = > 

IF (reason == cannotReachAS OR reason = tooBusy)AND 
retrys < timesToRetry 
THEN 
BEGIN 

addressesLeftlnCache: CARDINAL_ 

AuthServerCache.NextPlease[asAddress]; 

AuthServerCache.Refili[]; 

asAddress_AuthServerCache.ASAddressQ; 

retrys _ retrys + 1; 

LOOP; 

END; 
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3 ; 

EXIT; — Successful cal! 
ENDLOOP; 

END; 


— Public/Private pointer conversions — 


- Note; This is a hack to avoid exporting public types. 

- - (Because exported type dashes make it impossible for two 

- - different implementations which export the same type to co-exist.) 

PrivateidentityHandle: TYPE = LONG POINTER TO Authlnternal.identityObject; 
PrivateConversationHandle: TYPE - LONG POINTER TO Authlnternal.ConversationObject; 

PrivateConv: PROC [conversation: Auth.ConversationHandle] 

RETURNS [PrivateConversationHandle] = INLINE 
{RETURN[lOOPHOLE[conversation]]}; 

Privateldent; PROC [identity: Auth.ldentityHandle] 

RETURNS [PrivateidentityHandle] = INLINE 
{RETURN[LOOPHOLE[identity]]}; 

PrivateKey: PROC [key: Auth.Key] 

RETURNS [DESFace.Key] = INLINE 
{RETURN[LOOPHOLE[key]]>; 

PublicKey: PROC [privateKey: DESFace.Key] 

RETURNS [Auth.Key] * INLINE 

{RETURN[LOOPHOLE(privateKey]]}; 


END. 
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- - AuthAImpl.mesa 

- - JMciloney, 11 — Jul - 83 12:24:49. 

- Last modified: JMaloney, 20 - Jun - 84 11:16:36. 


DIRECTORY 
Auth USING [ 

AuthenticationProblem, CallProblem, 

CheckOutCredsAndNextVerifier, CheckSimpleCredentials, 

ConversationHandle, CopyCredentials, Credentials, FetchStrongCredentials, 

Flavor, HashedPassword, HashSimplePassword, identityHandle, Key, 
nullCredentials, nullHostNumber, nuIlKey, 
nullVerifier, PasswordStringToKey, Verifier, WhichArg], 

Authlnternal USING [ 

asStubHeap, CloneNSName, CtoneNSString, CloneVerifier, 

ConversationObject, EquivalentNames, FreeCredentials, 

FreeNSName, FreeNSString, FreeVerifier, identityObject, 

IncrementVerifierTicks, InternalAuthenticate, 
internalExtractCredentialsDetails, MakeEmptyNSName, 
MakeVerifierFromHashedPassword, MakeSimpleCredentials, 

NilOrNullName, PackStrongVerifier, Style, UnpackStrongVerifier], 

AuthProtocol USING [StrongVerifier], 

AuthSpecial USING [], 

CH USING [ 

ConversationHandle, FreeConversationHandle, 

LookupDistinguishedName, ReturnCode], 

Courier USING [Error], 

DESFace USING [CheckKeyParity, Key, nullKey], 

Heap USING [Create, MakeNode], 

NSName USING [ 

CopyNamefields, maxDomainLength, maxLocalLength, maxOrgLength, Name], 
NSString USING [nullstring. String], 

NSStringExtras USING [EquivalentNames], 

Process USING [InitializeMonitor, Pause, SecondsToTicks, Ticks], 

Router USING [AssignAddress], 

SharedKeys USING [asName, chsName, msName], 

SpecialCHAuth USING [], 

System USING [ 

GetClockPulses, GetGreenwichMeanTime, gmtEpoch, 

GreenwichMeanTime, HostNumber, NetworkAddress, 
nullHostNumber, SecondsSinceEpoch]; 

AuthAImpI: MONITOR 

LOCKS LOOPHOLE [identity, PrivateldentityHandlep USING identity: Auth.IdentityHandle 
IMPORTS 

Auth, Authlnternal, CH, Courier, DESFace, Heap, NSName, 

NSStringExtras, Process, Router, SharedKeys, System 
EXPORTS Auth, AuthSpecial, SpecialCHAuth 
SHARES Auth = 

BEGIN 


— Globals and constants — 


cacheConversations: BOOLEAN __ TRUE; 

conversationCacheTimeout: LONG CARDINAL = LONG[12] * LONG[60] * LONG[6Q]; 

— 12 hours, in seconds (half of the crentials lifetime). 

conversationHeap: UNCOUNTED ZONE _Heap.Create[initial: 4, increment: 4]; 

— All conversations and associated storage (creds, etc.) are allocated 

— from this heap. We no longer use the clients heap. This was 

— because conversation caching made it possible for one 

— client to lose storage owned by another. 

asStubHeap: UNCOUNTED ZONE = Authlnternal.asStubHeap; 

timesHaveHadToWaitForNextVerlfler: CARDINAL_0; 

— - This global is the number of times we've tried to create more than one 

— verifier within a given second and run out of ticks since the last boot. 

— It should be pretty small. 

thisMachinesAddress: System.NetworkAddress __ Router.A$signAddre$s[]; 


— Public errors — 


AuthentlcationError: PUBLIC ERROR [reason: Auth.AuthenticationProblem] = CODE; 

CallError; PUBLIC ERROR [reason: Auth.CallProblem, whichArg: Auth.WhichArg] - CODE; 

OrphanConversation: PU8LIC ERROR = COOE; 

- - This error is raised by Refresh only. 


— Private errors — 


BadLineClock: PRIVATE ERROR = CODE; 

- - indicates that the line dock is not advancing. 

- - Should never happen unless your hardware is broken. 
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Identities — 


Make Identity: PUBLIC PROC [ 

myName: NS Name. Name, password: NSString. String, z: UNCOUNTED ZONE, 
style: Auth.Flavor, dontCheck: BOOLEAN] 

RETURNS [identity: Auth.ldentityHandie] = 

BEGIN 

newldentity: PrivateldentityHandle; 

newldentity_z.NEW[Authlnternal.ldentityObject]; 

newldentity .style_style; 

newldentity.myName_Autbintemal.MakeEmptyNSNamejz]; 

-- - Assume: newldentity.myName will be big enough to hold myName; 

-■ - no heap will be needed by CopyNameFields. 

NSName.CopyNameFields[ 

z: NIL,source: myName, destination: newldentity.myName]; 
newldentity.myPassword _ Authlnternal.CloneNSString[password, z]; 

newldentity.myStrongKey_PrivateKey[Auth.PasswordStringToKey[password]]; 

newldentity.myHashedPassword ___ Auth.HashSimplePasswordfpassword]; 
newldentity.nameHasBeenResolved __ FALSE; 
newldentity.conversationsInUse _ NIL; 

newldentity .cachedConversations NIL; 

newldentity.owningHeap_z; 

Process.lnitializeMonitor[@newldentity.LQCK]; 
identity _ Publicldent[newldentlty]; 

IF ~dontCheck THEN SelfAuthenticate[ 

identity ! UNWIND = > Freeldentity[@identity, NIL]]; — No heap needed. 

END; 

MakeStrongldentityUsingKey: PUBLIC PROC [ 

myName: NSName.Name, myKey: Auth.Key, z: UNCOUNTED ZONE, 
dontCheck: BOOLEAN] 

RETURNS [identity: Auth.ldentityHandie] = 

BEGIN 

IF "DESFace.CheckKeyParity[LOOPHOLE[LONG[@myKey]]] 

THEN ERROR CallError[badKey, notApplicable]; 

identity Makeldentity[myName, NSString.nullstring, z, strong, TRUE]; 

Privateldent[identity]. myStrongKey PrivateKey[myKey]; 

IF -dontCheck THEN SelfAuthenticatef 

identity I UNWIND = > Free!dentity[@identity, NIL]]; - - No heap needed. 

END; 

Freeldentity: PUBLIC PROC [ 

identityPtr: LONG POINTER TO Auth.ldentityHandie, z: UNCOUNTED ZONE] a 
- - Note: z is no longer used. 

BEGIN 

CleanUpIdentity: ENTRY PROC [identity: Auth.ldentityHandie] = 

BEGIN 

ENABLE UNWIND = > NULL; 
thisOne: PrivateConversationHandle; 

— Clean up currently active conversations (making them orphans): 

- (These conversations are in use; they should not be freed.) 

thisOne_Privateldent[identity3.conversationslnUse; 

WHILE thisOne# NIL DO 

nextOne: PrivateConversationHandle _ thisOne.next; 

thisOne.owner_NIL; 

thisOne.next_NIL; 

thisOne_nextOne; 

ENDLOOP; 

- - Clean up cached conversations: 

- - (These conversations are not in use; they should be freed.) 
thisOne _ Privateident[identity].cachedConversations; 

WHILE thisOne# NIL DO 

nextOne: PrivateConversationHandle _thisOne.next; 

thisOne.owner_NIL; — Prevents monitor lock. 

InternalTerminate[LOOPHOLE[LONG[@thisOnej]]; 

thisOne_nextOne; 

ENDLOOP; 

Authlnterna!.FreeNSName[ 

@Privateldent[identity].myName, Privateldentfidentityj.owningHeap]; 
Authlnternal.FreeNSStringf 

@Privateldent[identity].myPas$word, Privateldent[identity].owningHeap]; 

END; 

IF identityPtr' = NIL THEN RETURN; 

CleanUpldentity[identityPtr"]; 

— There is a tiny race here; we free the monitor lock before we 

- - free the identity itself. This shouldn't matter; if the client 

— is calling Freeldentity, he'd better not be using it! 
Privateldent[identityPtr"].owningHeap.FREE[identityPtr]; 

— Smashes NIL Into identityPtr*. 

END; 


— Conversations — 


Initiate: PUBLIC PROC [ 

identity: Auth.ldentityHandie, recipientsName: NSName.Name, 

recipientsHostNumber: System.HostNumber Auth.nullHostNumber, 

z: UNCOUNTED ZONE] 

RETURNS [conversation; Auth.ConversationHandle] = 

— Note: z is no longer used. 

BEGIN 
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SELECT Authlnternal.$tyle[identity] FROM 
simple = > ResolveNamelfAlias[identity]; 

strong = > CheckForVaiidName[Privateldent[identity].myName, strong]; 

ENDCASE = > ERROR; 

conversation_lnternallnitiate(identity, recipientsName, recipientsHostNumber]; 

EIMD; 

Terminate: PUBLIC PROC [ 

conversationPtr: LONG POINTER TO Auth.ConversationHandle, z: UNCOUNTED ZONE] = 
BEGIN 

— Note: z is no longer used. 

lnternalTerminate[conversationPtr, cacheConversations]; 

END; 

Refresh: PUBLIC PROC [conversation: Auth.ConversationHandle] = 

BEGIN 

MonitoredFetchStrongCredentlals: ENTRY PROC [identity: Auth.ldentityHandlej = 

— If successful, sets values of newCreds and newConversationKey. 

— Assume: PrivateConv[conversation].owner = identity 
BEGIN 

ENABLE UNWIND = > NULL; 

[newCreds, newConversationKey]_ 

Auth.FetchStrongCredentials[ 

PrivateConv[conversation].owner.myName, 

PrivateConv[conversationj.recipient, 

PubiicKey[PrivateConv[conversation].owner.myStrongKey], 

PrivateConv[conversation].owningHeap]; 

END; 

newConversationKey: Auth.Key_Auth.nullKey; 

newCreds: Auth.Credentials __ Auth.nullCredentials; 

IF PrivateConv[conversatlon].owner = NIL THEN ERROR OrphanConversation; 

SELECT Authlnternai.Styie[Publicldent[PrivateConv[conversation].owner]] FROM 
simple = > RETURN; — Noop 
strong = > 

MonitoredFetchStrongCredentials[Publicident[PrivateConv[conversation].owner]]; 
ENDCASE = > ERROR; 

— We fetched new credentials using the conversation's heap. We 

— may now free the old conversation credentials and replace them 

— with the one's we just fetched. 

Authlnternal.FreeCredentials[ 

@PrivateConv(conversation].creds, 

PrivateConv[conversation].owningHeap]; 

PrivateConv[conver$ation].creds_newCreds; 

newCreds_Auth.nullCredentials; 

- - We've saved these credentials, so forget'em. 

PrivateConv[conver$ation].conver$ationKey_PrivateKey[newConversationKey|; 

PrivateConv[conversation].cIearLa$tVerifier 

_[System.GetGreenwichMeanTime[], GetRandomTicksForVerifier[]]; 

PrivateConv[conversation].creationTime__ System.GetGreenwichMeanTime[]; 

END; 

CheckOutCredentials: PUBLIC PROC [conversation: Auth.ConversationHandle] 

RETURNS [creds: Auth.Credentials] = 

BEGIN 

RETURN[PrivateConv[conversation].creds]; 

END; 

CheckOutNextVerifier: PUBLIC PROC [ 

conversation: Auth.ConversationHandle, recipientsHostNumber: System.HostNumber] 
RETURNS [verifier: Auth.Verifier] = 

BEGIN 

recipientsHostNumber_ 

IF recipientsHostNumber # System.nullHostNumber 
THEN recipientsHostNumber 

ELSE PrivateConv[conversation].recipientsHostNumber; 

RETURN[ 

ComputeNextVerifierForConversation( 

PrivateConv[conversation], 

recipientsHostNumber] 

]; 

END; 

CheckOutCredsAndNextVerifier: PUBLIC PROC f 
conversation: Auth.ConversationHandle, 
recipientsHostNumber; System.HostNumber] 

RETURNS [creds: Auth.Credentials, verifier: Auth.Verifier] = 

BEGIN 

recipientsHostNumber_ 

IF recipientsHostNumber # System.nullHostNumber 
THEN recipientsHostNumber 

ELSE PrivateConv[conversation].recipientsHostNumber; 

RETURN! 

PrivateConv[conversation].creds, 

ComputeNextVerifierForConver$ation[ 

PrivateConv[conver5ation], 

recipientsHostNumber]]; 

END; 


— Serialization — 


- NOTE; DescribeCredentials and DescribeVerifier are 

- exported by AuthProtocolImpl. 
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— Exports to AuthSpecial and SpecialCHAuth — 


— AuthSpecial.— 

MakeNullCHConversation: PUBLIC PROC [z: UNCOUNTED ZONE] 

RETURNS [nullCHConv: CH.ConversationHandle __ [NIL, NIL]] = 

BEGIN 

nullConv: PrivateConversationHandle _ 

z.NEW[Authlnternal.ConversationObject _ []3; 

nuilConv.owningHeap_z; 

nullCHConv.conversation_PublicConv[nullConv]; 

END; 

- - SpecialCHAuth. - - 

MakeConversationFromCredsAndVerifier: PUBLIC ENTRY PROC [ 

identity: Auth.ldentityHandle, creds: Auth.Credentials, verifier: Auth.Verifier, 
z: UNCOUNTED ZONE] 

RETURNS [conversation: Auth.ConversationHandle] = 

— Note: z is no longer used. 

BEGIN 

ENABLE UNWIND = > NULL; 
newConversation: PrivateConversationHandle; 
convKey: Auth.Key _Auth.nullKey; 
badCreds: BOOLEAN; 

SELECT creds.flavor FROM 
simple = > NULL; 
strong = > 

BEGIN 

— Assume: Privateldent[identity].style # simple 
[, convKey,,, badCreds,, ] _ 

Authlnternal.lnternalExtractCredentialsDetails[ 

PublicKey[Privateldent[identity].myStrongKey], creds, NIL, FALSE]; 

IF badCreds THEN ERROR AuthenticationError[credentialslnvalidI; 

END; 

ENDCASE => EFtROR AuthenticationError[credentialslnvalid]; 

newConversation _conversationHeap.NEW[Authlnternal.ConversationObject]; 
newConversation.recipient_NIL; 

— Assume: Noone will be interested in the recipient's name so why copy it? 

— NOTE: This is an orphan conversation. 

newConversation.creds __ Auth.CopyCredentials[creds, conversation Heap]; 

newConversation.lastVerifier_Auth.nullVerifier; — Filled in below. 

newConversation.conversationKey_PrivateKeyfconvKeyl; 

newConversation. incrementVerif ierByTicks_TRUE; 

newConversation.clearLastVerifier [System.gmtEpoch, 0]; 

newConversation.recipientsHostNumber __ System.nullHostNumber; 

newConversation.creationTime System.GetGreenwichMeanTimef]; 

newConversatlon.owner_NIL; 

newConversation.next_NIL; 

newConversation.owningHeap_conversationHeap; 

SELECT creds.flavor FROM 
simple = > 

newConversation. lastVerifier _ 

Authlnternal.CloneVerifier[verifier, conversationHeap]; 
strong - > 

BEGIN 

ENABLE UNWIND = > 

lnternalTerminate[LOOPHOLE[LONG(@newConversation]]]; 

— No monitor problems because newConversation is an orphan. 

newConversation.clearLastVerifier_ 

Authlnternal.UnpackStrongVerifier[ 

verifier, PrivateKey[convKey], thisMachinesAddress.host 
! Courier.Error = > ERROR AuthenticationError[verifierlnvalid]]; 

newConversation.lastVerifier_ 

DESCRIPTOR! 

Heap.MakeNode[conversationHeap, SIZE(AuthProtocol.StrongVerifier]], 
SIZE[AuthProtocol.StrongVerifier]]; 

END; 

ENDCASE => ERROR AuthenticationError[credentiaisinvalid]; 

RI:TURN[PubllcConv[newConversation]]; 

END; 


- - Private stuff — 


CheckForValidName: PROC [name: NSName.Name, style: Auth.Flavor] = 

-- - Raises an error (according to style) if the name is NOT ok. 

BEGIN 

IF Authlnternal.NilOrNullName[nameJ OR 

name.local.length > NSName.maxLocalLength OR 
name.domain.length > NSName.maxDomainLength OR 
name.org.length > NSName.maxOrgLength 
THEN ERROR CailError[ 

(IF style = simple THEN simpleKeyDoesNotExist ELSE strongKeyDoesNotExist), 
notApplicable]; 

END; 

ComputeNextVerifierForConversation: PROC [ 
conversation: PrivateConversationHandle, 
redpientsHostNumber: System.HostNumber] 
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RETURNS [nextVerifier: Auth.Verifier] = 

— This will compute a unique verifier later than last. If necessary, 

— - it will wait one second. If the timestamp in the verifier is greater than 

— the current time (i.e. in the future), you're out of luck. It has the 

— side effect of modifying the lastVerifier and ciearLastVerifier fields 

— of the conversation. 

BEGIN 

SELECT TRUE FROM 

conversation.creds.flavor = simple - > RETURN(conversation.lastVerifier]; 
conversation.incrementVerifierByTicks = > — strong, strange case — 

BEGIN 

conversation.clearLastVerifier __ 

Authlnternal.lncrementVerifierTicks[conversation.clearLastVerifier]; 

Authlnternal.PackStrongVerifier] 

from: ©conversation.clearLastVerifier, 
recipientsHostNumber: recipientsHostNumber, 
destVerifier: conversation.lastVerifier, 
key; conversation.conversationKey]; 

END; 

ENDCASE = > — strong, normal case — 

BEGIN 

last: AuthProtocol.StrongVerifier _ conversation.clearLastVerifier; 
timeOfLastVerifier, timeOfNextVerifier; LONG CARDINAL; 
oneSecond: Process.Ticks _ Process.SecondsToTicks[1]; 

next: AuthProtocol.StrongVerifier_[ 

timestamp: System.GetGreenwichMeanTime[], 
ticks: GetRandomTicksForVerifier(]]; 
timeOfLastVerifier _ System.Second$$inceEpoch[!ast.timeStamp]; 
timeOfNextVerifier _ System. SecondsSince£poch[next.time$tamp]; 

IF ^(timeOfNextVerifier > timeOfLastVerifier) THEN 
BEGIN 

IF timeOfNextVerifier < timeOfLastVerifier THEN ERROR BadLineClock; 
- - Time appears to be going backwards!!! 

_ _ if we get this far, timeOfNextVerifier = timeOfLastVerifier. Since 

— - we can't make duplicate verifiers, we've got to increment the ticks 

— or, if we've run out of ticks in a LONG CARDINAL, then we've got 

— to wait until the next second. (This should be VERY rare.) 

IF last.ticks # LAST[LONG CARDINAL] 

THEN next.ticks_last.ticks +■ 1 

ELSE 

BEGIN 

Proce$s.Pause[oneSecond]; 
timesHaveHadToWaitForNextVerifier _ 
timesHaveHadToWaitForNextVerifier + 1; 
next_[ 

timeStamp: System.GetGreenwichMeanTime]]. 
ticks: GetRandomTicksForVerifier]]]; 

IF System.SecondsSinceEpoch[next.timeStamp] < = 
timeOfLastVerifier 

THEN ERROR BadLineClock; 

— If, after pausing for a second, the clock 

— hasn't advanced, something must be wrong 

— with the clock... 

END; 

END; 

conversation.clearLastVerifier _ next; 

Authlnternal.PackStrongVerifier] 

from: ©conversation.clearLastVerifier, 
recipientsHostNumber: recipientsHostNumber, 
destVerifier: conversation.lastVerifier, 
key: conversation.conversationKey!; 

END; 

RETURN [conversation.lastVerifier]; 

END; 

GetConversationFromCache: INTERNAL PROC [ 

id: PrivateldentityHandle, recipient: NSName.Name] 

RETURNS [conv: PrivateConversationHandle_NIL] = 

BEGIN 

FindConversationFor: PROC [name: NSName.Name] 

RETURNS [convFound: PrivateConversationHandle] = 

BEGIN 

previous: LONG POINTER TO PrivateConversationHandle; 

IF Authlnternal.NiiOrNuHName[name] THEN RETURN[NIL]; 

— Find the conversation (if any) preceding the one 

— we'd like to use. 

previous_@id.cachedConversations; 

WHILE previous" # NIL DO - - For entire list, do: 

IF NS$tringExtras.EquivalentNames[previous\recipient, name] 

THEN EXIT; - - Found one! 

previous_©previous" .next; 

ENDLOOP; 

IF previous" = NIL THEN RETURN[N!L]; - - Didn't find one. 

— Found one, splice it out: 

convFound_previous"; 

previous" __ convFound.next; 

- - Put it on the front of the list of conversations in use: 

convFound.next id.conversatlonsInUse; 

id.conversationslnUse_convFound; 

RETURN[convFound]; 

END; 

WeedOutOidConversations; PROC = 

BEGIN 

previous: LONG POINTER TO PrivateConversationHandle _ 
@id.cachedConversatlon$; 

convToRemove: PrivateConversationHandle_NIL; 

- - Seek out and destroy all old conversations: 
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WHILE previous' # NIL DO — For entire list, do 
SELECT OldConversation[previous'] FROM 
FALSE = > 

BEGIN 

previous_©previous" .next; 

LOOP; — This is a young entry; pass over it. 

END; 

TRUE = > 

BEGIN 

convToRemove_previous'; 

— Splice this conversation out of list: 

previous' previous*.next; 

- - Kill it: 

convToRemove.owner_NIL; 

lnternalTerminate[LOOPHOLE[LONG[@convToRemove]]]; 

END; 

ENDCASE; 

ENDLOOP; 

END; 

WeedOutOldConversationsE]; 

RETURN [FindConversationFor[recipient]]; 

END; 

GetRandomTicksForVerifier: PROC RETURNS [ticks: LONG CARDINAL] = 

BEGIN 

ticks_System. GetClockPulse$[]; 

IF ticks > 10000 THEN ticks _ ticks - 10000; 

- - This makes sure that ticks is within [O..MAX[LONG CARDINAL] - 10000]. 

— That way, we can make up to 10000 verifiers within a given second 

— by incrementing the ticks field. 

END; 

Internailnitiate: PRIVATE ENTRY PROC [ 

identity: Auth.ldentityHandle, recipientsName: NSName.Name, 
recipientsHostNumber; System.HostNumber _ Auth.nullHostNumber] 

RETURNS [conversation: Auth.ConversationHandle] - 
BEGIN 

ENABLE UNWIND = > NULL; 
newConversation: PrivateConversationHandle; 
newCreds: Auth.Credentials; 
newConversationKey: Auth.Key_Auth.nuIlKey; 

newConversation _ 

GetConversationFromCache[Privateldent[identity], recipientsName]; 

IF newConversation # NIL THEN 

BEGIN — if there was a conversation in the cache, use it! 

newConversation.recipientsHostNumber _ recipientsHostNumber; 
RETURN[PubitcConv[newConversation]]; 

END; 

— No credentials in the cache, so manufacture or fetch some: 

SELECT Privateldent[identity].style FROM 
simple = > 
newCreds_ 

Authlnternal.MakeSimpleCredentials[ 

Privateldent[identity].myName, conversationHeap]; 
strong = > 

[newCreds, newConversationKey] _ 

Auth.FetchStrongCredentials[ 

Private!dent[identity].myName, recipientsName, 
PublicKey[Privateldent[identity].myStrongKey], conversationHeap]; 
ENDCASE = > ERROR; 

newConversation_conver$ationHeap.NEW[Authlnternai.ConversationObject]; 

newConversation.recipient _ 

Authlnternai.CloneN$Name[recipientsName, conversationHeap]; 
newConversation.creds_newCreds; 

newConversation.lastVerifier _ Auth.nuliVerifier; — Filled in below. 

newConversation.conversationKey_PrivateKey[newConversationKey]; 

newConversation.incrementVerifierByTicks_FALSE; 

newConver$ation.clearLa5tVerifier_ 

[System.GetGreenwichMeanTime]], GetRandomTicksForVerifier[]]; 
newConversatlon.recipientsHostNumber _ recipientsHostNumber; 

newConversation.creationTime System. GetGreenwichMeanTime]]; 

newConversation.owner_NIL; 

newConversation.next _ NIL; 
newConversation.owningHeap_conversationHeap; 

SELECT TRUE FROM 

newConversation.creds = Auth.nullCredentials = > 

newConversation.lastVerifier_Auth.nuliVerifier; 

Privateident[identity].style = simple = > 

newConversation.lastVerifier_ 

Authlnternal.MakeVerifierFromHashedPassword[ 

Privateident[identity].myHashedPassword, conversationHeap]; 
Privateldent[identity].styie = strong = > 
newConversation.lastVerifier _ 

DESCRIPTORf 

Heap.MakeNode[conversationHeap, SIZE[AuthProtocol.StrongVerifier]}, 
SiZE[AuthProtocol.StrongVerifier]]; 

ENDCASE = > ERROR; 

— Put on front of identity's list of conversations in use: 

newConversation.owner_Privateldent[identity]; 

newConversation.next_Privateldent[identity].conversationslnUse; 

Privateldent[identity].conversation$lnUse _ newConversation; 
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RETURN(PublicConv[newConversation]]; 

END; 

InternalTerminate: PROC [ 

conversationPtr: LONG POINTER TO Auth.ConversationHandle, 
okToCache: BOOLEAN _ FALSE] = 

BEGIN 

RemoveConvFromldentity: ENTRY PROC [identity: Auth.ldentityHandle] 3 
— Removes conversationPtr" from identity.conversationslnUse. 

BEGIN 

ENABLE UNWIND = > NULL; 

— Assume: identity = PrivateConv[conversationPtr‘].owner 
— Assume: identity # NIL 

previous: LONG POINTER TO PrivateConversationHandle_ 

@Privateldent[identity].conversationslnUse; 

- - Find previous conversation in chain: 

DO 

IF previous" = PrlvateConv(conversationPtr'j THEN EXIT; 

IF previous" = NIL THEN ERROR; 

— - A conversation has an owner that doesn't know about 

— the conversation. This "can't" happen (if it does there 

— is a bug in this code somewhere, 
previous _ @previous\next; 

ENDLOOP; 

- - Splice out this conversation: 

previous’_PrivateConv[conversationPtr"].next; 

PrivateConv[conver$ationPtr"].next _ NIL; 

END; 

OfferConvToldentityCache: ENTRY PROC [ 

identity: Auth.ldentityHandle, conversation: PrivateConversationHandlel 
RETURNS [accepted: BOOLEAN __ FALSE] = 

— This operation may add conversation to identity.cachedConversations. 

— if it does, accepted will be set to TRUE. 

BEGIN 

ENABLE UNWIND = > NULL; 

IF ~okToCache 

OR conversation.incrementVerifierByTicks 
OR OldConversation[conversation] 

OR Authlnternal.NilOrNullName[conversation.recipient] 

THEN RETURN[accepted: FALSE]; 

conversation.next_Privateldent[identity].cachedConversations; 

Privateldent[identity].cachedConversations _ conversation; 

RETURNlaccepted: TRUE]; 

END; 

addedToCache: BOOLEAN; 

IF conversationPtr" = NIL THEN RETURN; — Nothing to do. 

IF PrivateConv[conversationPtr“].owner # NIL THEN 
BEGIN 

RemoveConvFromldentity[Publicldent[PrivateConv[conver$ationPtr"].owner]]; 

addedToCache_ 

OfferConvToldentityCache] 

PubIicldent[PrivateConv[conver$ationPtr"].owner], 

PrivateConv[conversationPtr"]]; 

IF addedToCache 

THEN {conversationPtr" _NIL; RETURN); 

— Do NOT free the conversation; do set it to NIL. 

END; 

— Free the conversation: 

Authlntemal.FreeNSName[ 

@PrivateConv[conversationPtr"].recipient, 
PrivateConv[conversationPtr"].owningHeap]; 

Authlnternal.FreeCredentialsf 

@PrivateConv[conversationPtr"].creds, 

PrivateConv[conver$ationPtr A ].owningHeap]; 

Authinternal.FreeVerifierf 

@PrivateConv[conversationPtr"].lastVerifier, 

PrivateConv[conversationPtr"].owningHeap]; 

PrivateConv[conversationPtr"].owningHeap.FREE[conversationPtr]; 

— Smashes NIL into conversationPtr". 

END; 

isWellKnownName: PROC [name: NSName.Name] 

RETURNS [isWellKnown: BOOLEAN] = 

BEGIN 

RETURN! 

Authlnternai.EquivalentName$[name, SharedKeys.asName] OR 
Authlnternal.EquivalentNames[name, SharedKeys.chsName] OR 
Authlnternal.EquivafentNames[name, SharedKeys.msName] 

1 ; 

END; 

MakeSimpleCHOrphanConversation; PROC [ 

for: NSName.Name, hashedPassword: Auth.HashedPassword] 

RETURNS [chConv: CH.ConversationHandle] = 

BEGIN 

chConv_MakeNullCHConversation[asStubHeap]; 

PrivateConv[chConv.conversation].creds_ 

Authlnternal.MakeSimpleCredentials[for, asStubHeap]; 

PrivateConv[chConv.conversation].lastVerifier_ 

Authlnternal.MakeVerifierFromHa$hedPas$word[hashedPassword, asStubHeap]; 

END; 

OldConversation: PROC [conv: PrivateConversationHandle] 

RETURNS [isOld: BOOLEAN] = 
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BEGIN 

now: LONG CAROINAL _ 

System.SecondsSinceEpoch[System.GetGreenwichMeanTime[]]; 

then: LONG CARDINAL _ 

System.SecondsSinceEpochfconv.creationTime]; 

IF then > now 

THEN isOld_TRUE 

- - Clock is running backward?? Consider the conversation ''old". 

ELSE isOld _ ((now - then) > conversationCacheTimeout); 

END; 

ResolveNamelfAlias: ENTRY PROC (identity: Auth.identityHandlej = 

-- - Assume: This operation gets called only with a simple identity. 

BEGIN 
ENABLE { 

AuthenticationError => ERROR CaliError[badKey, initiator]; 

UNWIND = > NULL; 

}; 

chConversation: CH.ConversationHandie _ [NIL, nil]; 

distingName; NSName.Name_NIL; 

rc: CH.ReturnCode; 

IF Privateldent(identity].nameHasBeenResolved THEN RETURN; 
CheckForValidName[Privateldent[identity].myName, Privateldent(identity].style]; 
IF !sWellKnownName{Privateldent[identity].myName] THEN 
BEGIN 

Privateldent[identity].nameHasBeenResolved _ TRUE; 

RETURN; 

END; 

chConversation_MakeSimpleCHOrphanConversationf 

Privateldent[identity].myName, Privateldent[identity].myHashedPassword]; 
distingName _ Authlnternal.MakeEmptyNSName[asStubHeap]; 

BEGIN 

ENABLE UNWIND =s > { 

CH.FreeConversationHan‘dle[@chConversation, NIL]; 
Authlnternal.FreeNSName[@distingName, asStubHeap]; 


rc __ CH.LookupDistinguishedName( 
chConversation, Privateldent(identity].myName, distingName]; 

SELECT rc.code FROM 
done = > 

BEGIN 

— Assume: Private!dent[identity].myName is big enough; 

— no heap will be needed by CopyNameFields. 
N$Name.CopyNameFields[ 
z: NIL, source: distingName, 
destination: Privateident[identity].myName]; 
Privateldent[identity].nameHasBeenResoived __ TRUE; 

END; 

noSuchOrg, noSuchDomain, noSuchLocal, 
illegalOrgName, iilegalDomainName, iilegaiLocalName = > 

ERROR CallError[simpleKeyDoe$Not£xist, initiator]; 
rejectedTooBusy = > 

ERROR CaflError[tooBusy, notApplicable]; 
allDown = > 

ERROR CailErrorfkeysUnavaifable, initiator]; 
credentialslnvalid = > 

ERROR CaliError[badKey, initiator], 

ENDCASE => ERROR CallError{simpleKeyDoesNotExist, initiator]; 
Authlnternal.FreeNSName[@distingName, asStubHeap]; 

END; 

CH,FreeConversationHandIe[@chConversation, NIL]; 

END; 

SelfAuthenticate: PROC [identity: Auth.ldentityHandle] * 

— This operation will also resolve the name in the identity handle. 

- - Assume: This procedure is only called from an identity creation procedure! 
BEGIN 

creds: Auth.Credentials Auth.nullCredentials; 

verifier: Auth.Verifier _ Auth.nullVerifier; 
conv: Auth.ConversationHandle_NIL; 

SELECT Privateldent(identity].style FROM 
simple = > 

ResolveNamelf Alias[identity]; 
strong = > 

CheckForValidName[Privateldent[identity].myName, strong]; 

— - Note: Since the strong credentials produced by the AS always contain 

— a distinguished name, we save a Clearinghouse operation by extracting 

— the dlsinguished name from the credentials that we are using to check 

— this identity. 

ENDCASE » > ERROR; 

SELECT Privateldent[ldentity].style FROM 
simple = > 

BEGIN 

ENABLE UNWIND = > lnternalTerminate[@conv]; 

conv _ lnternaHnitiate[identity, Privateldent[identity].myName]; 

[creds, verifier] _Auth.CheckOutCred$AndNextVerifier[conv]; 

IF ~Auth.CheckSimpleCredentials[creds, verifier].ok 
THEN ERROR CallError[badKey, notApplicable]; 
lnternalTerminate[@conv]; 

END; 
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strong = > 

BEGIN 

ENABLE UNWIND - > internalTerminate[@conv]; 
distlngName: NSName.Name_NIL; 

conv _ lnternallnitiate[identity, Privatetdent[identity].myName]; 

[creds, verifier]_ 

CheckOutCredsAndNextVerifier[conv,thisMachinesAddres$.hostj; 

— To get the distinguished name for strong credentials, do an 
— Authenticate, which returns the distinguished name (which was 

— resolved by the server). Replace the identity.myName with this name. 
[distingName,, ] _ Authlnternal.lnternalAuthenticate{ 

Pub!icKey[Privateldent[identity].myStrongKey], creds, verifier, 
asStubHeap, thisMachinesAddress.host, 

FALSE, FALSE, TRUE, FALSE 

! AuthenticationError = > ERROR CallErrorfbadKey, notApplicable]]; 

— Assume: Privatetdent[identity].myName is big enough; 

— no heap will be needed by CopyNameFields. 

NSName.CopyNameFieids[ 

z: NIL, source: distingName, destination: Private!dent[identity].myName]; 
Authlnternal.FreeNSName(@distingName, asStubHeap]; 

Privateldent[identity].nameHa$BeenResolved_TRUE; 

lnternalTerminate[@conv]; 

END; 

ENDCASE a > ERROR; 

END; 


— Public/Private pointer conversions — 


— Note: This is a hack to avoid exporting public types. 

— (Because exported type dashes make it impossible for two 

— different implementations which export the same type to co - exist.) 

PrivateldentityHandle: TYPE = LONG POINTER TO AuthlnternaUdentityObject; 

PrivateConversationHandle: TYPE = LONG POINTER TO Authlnternai.ConversationObject; 

PrivateConv: PROC [conversation: Auth.ConversatlonHandle] 

RETURNS [PrivateConversationHandle] = INLINE 
{RETURN[LOOPHOLE[conversation]]>; 

PublicConv: PROC [privateConversation: PrivateConversationHandle] 

RETURNS [Auth.ConversationHandle] =* INLINE 
{RETURN[LOOPHOLE[privateConversation]]>; 

Privateldent: PROC [identity: Auth.ldentityHandle] 

RETURNS [PrivateldentityHandle] = INLINE 
{RETURN[LOOPHOLE [identity]]}; 

Publicldent: PROC [privateldentity: PrivateldentityHandle] 

RETURNS [Auth.ldentityHandle] = INLINE 
{RETURN[LOOPHOLE[privateldentity]]}; 

PrivateKey: PROC [key: Auth.Key] 

RETURNS [DESFace.Key] = INLINE 
{RETURN[LOOPHOLE[key]]>; 

PublicKey: PROC [privateKey: DESFace.Key] 

RETURNS [Auth.Key] = INLINE 

{RETURN[LOOPHOLE[privateKeyl]>; 
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- •- AuthClmpl.mesa 

~ -- JMaloney, 11 — Jul — 83 12:24:49. 

- -- Last modified: JMaloney, 3-Jul - 84 12:00:10. 


DIRECTORY 
Auth USING [ 

AuthenticationError, CallError, CallProblem, 

CheckOutCredsAndNextVerifier, ConversationHandle, 

Credentials, Flavor, HashedPassword, HashSimplePassword, 

IdentityHandle, Initiate, Key, nuflCredentials, 
nullHashedPassword, nullKey, nulIVerifier, 

PasswordStringToKey, Terminate, Verifier, WhichArg], 

Authlnternal USING [ 

asStubHeap, BadCredentialsPackage, CloneNSString, 

ConversationObject, ExtractStuffFromCredentialsPackage, FreeNSString, 
FreeSimpleCredentials, IdentityObject, 

Style, UnpackSimpleCredentials], 

AuthOps USING [ 

ChangeSimpleKey, ChangeStrongKey, 

CreateSimpleKey, CreateStrongKey, 

DeleteSimpleKey, DeleteStrongKey, 

CheckSimpleCredentials, GetStrongCredentialsl, 

AuthProtocol USING [ 

CredentialsPackage, DescribeCredentialsPackage, SimpleCredentials], 

AuthServerCache USING [ASAddress, NextPlease, Refill], 

Courier USING [Description, Error, Free], 

DESFace USING [Block, CheckKeyParity, EncryptBlock, Key, nullKey], 

MSName USING [Name], 

NSString USING [String], 

Process USING [MsecToTicks, Pause, Ticks], 

SharedKeys USING [asName], 

System USING [GetClockPulses, NetworkAddress, nuilNetworkAddress]; 

AuthClmpI: MONITOR 

LOCKS LOOPHOLE[identity, PrivateldentityHandle]" USING identity: Auth.ldentityHandle 
IMPORTS 

Auth, Authlnternal, AuthProtocol, AuthOps, AuthServerCache, Courier, 

DE5Face, Process, SharedKeys, System 
EXPORTS Auth 
SHARES Auth = 

BEGIN 


— Globals and constants — 


cacheNeverFilled: BOOLEAN _ TRUE; 

pauseForlnitialCacheFill: Process.Ticks_ Process.MsecToTicks[15000]; 

— fifteen seconds 

timesToRetry: CARDINAL _ 1; 

— The number of times to grab a new address out of the cache and re - try 

— an operation which must talk to an AS. 


— Password/Key administration operations — 


ChangeMyPasswords: PUBLIC PROC [ 

identity: Auth.ldentityHandle, newPassword: NSString.String, z: UNCOUNTED ZONE, 
changeStrong,change$imple: BOOLEAN] = 

BEGIN 

ComputeOIdKeyValues: ENTRY PROC [identity: Auth.ldentityHandle] 

RETURNS [oldStrongValue: Auth.Key, oldSimpleValue: Auth.HashedPassword] = 

— Computes oldStrongValue and oldSimpleValue from password 
- - in identity handle. 

BEGIN 

ENABLE UNWIND = > NULL; 
oldStrongValue_ 

Auth.PasswordStringToKey[Privateldent[identity].myPassword]; 
oldSimpleValue_ 

Auth.HashSimplePas5word[Privateldent[identity].myPassword]; 

END; 

Changeldentitylnfo: ENTRY PROC [identity: Auth.ldentityHandle] = 

— Fix up the password info in the identity. 

BEGIN 

ENABLE UNWIND = > NULL; 

Authlnternal.FreeNSString! 

@Private!dent[identity].myPassword, Prlvateldent[identity].owningHeap]; 
Pfivateldent[identity].myPassword _ 

Authlnternal.CloneNSString[newPassword, Private!dent[identity].owningHeap]; 
IF changeStrong 

THEN Privateldent[identity].myStrongKey _ PrivateKey[newStrongKey]; 

IF changeSimple 

THEN Privatetdent[identity].myHashedPa$sword _ newHashedPassword; 

END; 

newStrongKey: Auth.Key _ Auth.PasswordStringToKey[newPassword]; 
newHashedPassword: Auth.HashedPassword __ 
Auth.HashSimplePassword[newPassword]; 

IF changeStrong THEN Changes trongKeyfidentity, newStrongKey]; 

IF changeSimple THEN 
BEGIN 
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ENABLE UNWIND = > { 

— Undo what we have done so far... 
oidStrongKey: Auth.Key __ Auth.nuIlKey; 

oldSimpleKey: Auth.HashedPassword_Auth.nuilHashedPassword; 

[oidStrongKey, oldSimpleKey] _ ComputeOldKeyValues[identity]; 

IF changeStrong THEN 
Change$trongKey[ 
identity, oidStrongKey 

! Auth.AuthenticationError, Auth.CallError = > CONTINUE]; 
ChangeSimpleKey[ 
identity, oldSimpleKey 

! Auth.AuthenticationError, Auth.CallError = > CONTINUE]; 

>; 

ChangeSimpleKeyjjdentity, newHashedPassword]; 

END; 

- - If we got this far it worked; we can fix up identityObject. 
Changeldentitylnfo[identity]; 

END; 

CreateStrongKey: PUBLIC PROC [ 

identity: Auth.ldentityHandle, name: NSName.Name, newStrongKey: Auth.Key] = 
BEGIN 

Dolt: PROC [ 

creds: Auth.Credentials, verifier; Auth.Verifier, conv: Auth.ConversationHandle, 
asAddressPtr: LONG POINTER TO System.NetworkAddress] - 
BEGIN 

encryptedinltialKey: DESFace.Block; 

DESFace.EncryptBlock[ 

key: PrivateConv[conv].conversationKey, 

from: LOOPHOLE[LONG[@newStrongKey]],to: @encryptedlnitialKey]; 
AuthOps.CreateStrongKeyi 

creds, verifier, name, encryptedlnitialKey, asAddressPtr]; 

END; 

SELECT Authlnternal.Style[identity] FROM 

simple = > ERROR Auth.AuthenticationError[inappropriateCredentials]; 
strong = > ConverseWithASAndCailMefidentity, name. Dolt]; 

ENDCASE = > ERROR; 

END; 

ChangeStrongKey: PUBLIC PROC [ 

identity: Auth.ldentityHandle, newStrongKey: Auth.Key] = 

BEGIN 

Changeldentitylnfo: ENTRY PROC [identity: Auth.ldentityHandle] = 

BEGIN 

ENABLE UNWIND = > NULL; 

Auth Internal.FreeNSString] 

@Privateldent[identity].myPassword, Privateldent[identity].owningHeap]; 

- - Leave password a nullstring because it is no longer related to 

— the "truth” in identity.myStrongKey. 

Privatefdent[identity].myStrongKey _ PrivateKeyfnewStrongKey]; 

END; 

Dolt: PROC [ 

creds: Auth.Credentials, verifier: Auth.Verifier, conv: Auth.ConversationHandle, 
asAddressPtr: LONG POINTER TO System.NetworkAddress] = 

BEGIN 

encryptedNewKey: DESFace.Block; 

DESFace.EncryptBlock[ 

key: PrivateConv[conv].conversationKey, 

from: LOOPHOLE[LONG[@newStrongKey]], to: ^encryptedNewKey]; 
AuthOps.ChangeStrongKey[creds, verifier, encryptedNewKey, asAddressPtr]; 
END; 

SELECT Authinternal.Styfe[identity] FROM 

simple = > ERROR Auth.AuthenticationError(inappropriateCredential$]; 
strong = > 

ConverseWithASAndCallMe[identity, Privateldent[identity].myName, Dolt]; 
ENDCASE = > ERROR; 

— If we got this far it worked; we can fix up identityObject. 
Changeldentltylnfo[identity]; 

END; 

DeleteStrongKey: PUBLIC PROC [identity: Auth.ldentityHandle, name: NSName.Name] = 
BEGIN 

Dolt: PROC [ 

creds: Auth.Credentials, verifier: Auth.Verifier, conv: Auth.ConversationHandle, 
asAddressPtr: LONG POINTER TO System.NetworkAddress] = 

BEGIN 

AuthOps. DeleteStrongKey [creds, verifier, name, asAddressPtr]; 

END; 

SfiLECT Authlnternai.Style[identity] FROM 

simple = > ERROR Auth,AuthenticationError[inappropriateCredentials]; 
strong = > Conver$eWlthASAndCallMe[identity, name. Dolt); 

ENDCASE = > ERROR; 

END; 

CreateSimpleKey: PUBLIC PROC [ 

identity: Auth.ldentityHandle, name: NSName.Name, 
newSimpleKey: Auth.HashedPassword] = 

BEGIN 

Dolt: PROC[ 

creds: Auth.Credentials, verifier; Auth.Verifier, conv: Auth.ConversationHandle, 
asAddressPtr: LONG POINTER TO System.NetworkAddress] =* 


AuthClmpl.mesa 3-Jul - 84 12:00:11 PDT 




BEGIN 

AuthOps.CreateSimpleKey( 

creds, verifier, name, newSimpleKey, asAddressPtr]; 

END; 

ConverseWithASAndCallMe[identity, name. Dolt]; 

END; 

ChangeSimpleKey: PUBLIC PROC [ 

identity; Auth.ldentityHandle, newSimpleKey: Auth.HashedPassword] = 

BEGIN 

Cheingeldentitylnfo: ENTRY PROC (identity; Auth.ldentityHandle] = 

BEGIN 

ENABLE UNWIND = > NULL; 

Authlnternal.FreeNSString[ 

@Privateldent[identity].myPa$sword, Privateldent(identity].owningHeap]; 
— Leave password a nullstring because it is no longer related to 
— the "truth" in identity.myHashedPassword. 
Privatetdent[identity].myHashedPassword _ newSimpleKey; 

END; 

Dolt: PROC [ 

creds: Auth.Credentials, verifier: Auth.Verifier, conv: Auth.ConversationHandle, 
asAddressPtr: LONG POINTER TO System.NetworkAddress] = 

BEGIN 

AuthOps.ChangeSimpleKey[creds, verifier, newSimpleKey, asAddressPtr]; 
END; 

ConverseWithASAndCallMelidentity, Privateldent(identity].myName, Dolt]; 

- - if we got this far it worked; we can fix up identityObject. 

Changeldentitylnf o[identity]; 

END; 

DeleteSimpleKey: PUBLIC PROC [identity: Auth.ldentityHandle, name: NSName.Name] = 
BEGIN 

Dolt: PROC [ 

creds: Auth.Credentials, verifier: Auth.Verifier, conv: Auth.ConversationHandle, 
asAddressPtr: LONG POINTER TO System.NetworkAddress] = 

BEGIN 

AuthOps.DeieteSimpleKey[creds, verifier, name, asAddressPtr]; 

END; 

ConverseWithA$AndCallMe[identity, name, Dolt]; 

END; 


— Credentials operations which call the server — 


CheckSimpleCredentials: PUBLIC PROC [ 

creds: Auth.Credentials, verifier: Auth.Verifier] 

RETURNS [Ok: BOOLEAN _ FALSE] * 

BEGIN 

Dolt: PROC [asAddressPtr: LONG POINTER TO System.NetworkAddress] = 

BEGIN 

ok _ AuthOps.CheckSimpleCredential$[creds, verifier, asAddressPtr]; 

END; 

IF creds.fiavor # simple 

THEN ERROR Auth.AuthenticationError[credentialslnvalidj; 

BEGIN 

simpleCreds: AuthProtocol.SimpleCredentials _ 
Authlnternal.UnpackSimpleCredentials( 
creds, Authlnternal.asStubHeap 

I Courier.Error = > ERROR Auth.AuthenticationError[credentialslnvalid]]; 

— The following calls the AS and sets ok: 

ContactASAndCallMe[ 

Dolt, simpleCreds.initiator 
! UNWIND a > 

Authlnternal.FreeSimpleCredentials[@simpleCreds, Authlnternal.asStubHeap]]; 
Authlnternal.FreeSimpleCredentiais[@$impleCreds, Authlnternal.asStubHeap]; 

END; 

END; 

FetchStrongCredentials: PUBLIC PROC [ 
initiator, recipient: NSName.Name, 
initiatorsStrongKey: Auth.Key, z: UNCOUNTED ZONE] 

RETURNS [creds: Auth.Credentials, conversationKey: Auth.Key] = 

BEGIN 

Dolt: PROC [asAddressPtr: LONG POINTER TO System.NetworkAddress] - 
BEGIN 

credentialsPackage_ 

AuthOps.GetStrongCredentials(initiator, recipient, nonce, asAddressPtr]; 

END; 

convKey: DESFace.Key __ DESFace.nullKey; 
credentialsPackage: AuthProtocol.CredentialsPackage; 

nonce: LONG CARDINAL_System.GetClockPulses(]; 

SELECT TRUE FROM 

initiator =s NIL = > ERROR Auth.CallError[strongKeyDoesNotExist, initiatorl; 
recipient = NIL = > ERROR Auth.CallError[strongKeyDoesNotExist, recipient]; 
ENDCASE; 

ContactASAndCallMe[Dolt, initiator]; - - fills in credentialsPackage 
BEGIN 

ENABLE UNWIND = > Courier.Free( 

[@credentialsPackage, AuthProtocoi.DescribeCredentialsPackage], 
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Authlnternal.asStubHeap]; 


[creds, conv Key]_ 

Authlnternal.£xtractStuffFromCredentialsPackage[ 
credentialsPackage, PrivateKey[initiatorsStrongKey], 
recipient, nonce, z 

! Authlnternal.BadCredentialsPackage = > 

ERROR Auth.CallErrorfbadKey, notApplicabie]]; 

IF *~DESFace.CheckKeyParity[@convKey] 

THEN ERROR Auth.CallError[badKey, notApplicabie]; 

END; 

Courier.Freef 

[@credentialsPackage, AuthProtocol.DescribeCredentialsPackage], 
Authlnternal.asStubHeap]; 

RETURNfcreds, PublicKeyJconvKey]]; 

END; 


— Private stuff — 


ConverseWithASAndCallMe: PROC [ 

identity: Auth.ldentityHandle, nameHint: NSName.Name, 
procToCall: PROC[ 

Auth. Credentials, Auth.Verifier, Auth.ConversationHandle, 

LONG POINTER TO System.Network Address]] = 

BEGIN 

retrys: CARDINAL_0; 

asAddress: System.NetworkAddress _ System.nullNetworkAddress; 

creds: Auth.Credentials_Auth.nullCredentrals; 

verifier: Auth.Verifier _ Auth.nullVerifier; 
conv: Auth.ConversationHandle; 

conv _ Auth.lnitiatefidentity, SharedKeys.asName,, Authlnternal.asStubHeap]; 

asAddress_AuthServerCache.ASAddressfnameHint]; 

BEGIN 

ENABLE UNWIND = > Auth.Terminate[@conv, Authlnternal.asStubHeap]; 

DO 

[creds, verifier] _ Auth.CheckOutCredsAndNextVerifier[conv, asAddress.host]; 
procToCallf 

creds, verifier, conv, @asAddress 
I Auth.CallError = > 

IF (reason = cannotReachAS OR reason = tooBusy) AND 
retrys < timesToRetry 
THEN 
BEGIN 

addressesLeftlnCache: CARDINAL _ 
AuthServerCache.NextPlease[asAddress]; 
AuthServerCache.Refill[]; 
asAddress _ AuthServerCache.ASAddress]]; 
retrys _ retrys + 1; 

LOOP; 

END; 

Auth.AuthenticationError = > 

— The reason must be credentialslnvalid; this is highly unusual! 
{ERROR Auth.CallErrorfbadKey, notApplicabie]}; 

EXIT; - - Successful call 
ENDLOOP; 

END; 

Auth.Terminate[@conv, Authlnternal.asStubHeap]; 

END; 

ContactASAndCallMe: PROC [ 

procToCall: PROC [LONG POINTER TO System.NetworkAddress], 
nameHint: NSName.Name] = 

BEGIN 

retrys: CARDINAL _0; 

asAddress: System.NetworkAddress _ AuthServerCache.ASAddress(nameHint]; 

IF cacheNeverFilled THEN 
BEGIN 

AuthServerCache.Refill!]; 

cacheNeverFilled _ FALSE; 3 

IF asAddress = System.nullNetworkAddress THEN 
BEGIN 

Process.Pause[pauseForlnitialCacheFlll]; - - Wait only if we have to. 

asAddress_AuthServerCache.ASAddressO; 

END; 

END; 

DO 

procToCallf 
@as Address 
! Auth.CallError = > 

IF (reason = cannotReachAS OR reason = tooBusy) AND 
retrys < timesToRetry 
THEN 
BEGIN 

addressesLeftlnCache: CARDINAL _ 
AuthServerCache.NextPlease[asAddress]; 
AuthServerCache.Refi!l[]; 

asAddress_AuthServerCache.ASAddress[]; 

retrys _ retrys + 1; 

LOOP; 

END; 
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EXIT; — Successful call 
ENDLOOP; 

END; 


Public/Private pointer conversions — 


— Note; This is a hack to avoid exporting public types. 

— (Because exported type clashes make it impossible for two 

— different implementations which export the same type to co - exist.) 

PrivateldentityHandle: TYPE = LONG POINTER TO Authlnternal.ldentityObject; 
PrivateConversationHandle; TYPE = LONG POINTER TO Authlnternal.ConversationObject; 

PrivateConv; PROC [conversation: Auth.ConversationHandle] 

RETURNS [PrivateConversationHandle] = INLINE 
{RETURN[LOOPHOLE[conversation]j}; 

Privateldent: PROC [identity; Auth.ldentityHandle] 

RETURNS [PrivateldentityHandle] = INLINE 
{RETURN [LOOPHOLE [identity]]}; 

PrivateKey: PROC [key: Auth.Key] 

RETURNS [DESFace.Key] = INLINE 
{RETURN[LOOPHOLE[key]]>; 

PubiicKey: PROC [privateKey: DESFace.Key] 

RETURNS [Auth.Key] = INLINE 
{RETURN[LOOPHOLE[privateKey]]>; 


END. 
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$M001&6 

SPACELENGTH (72) 
SPAGEWIDTH (136) 




stored as MesaVM.asm 


created on 

19-Jul-84 

13:20:18 

; 1 ast edited 

by: 


; - KEK 

30-Apr-87 

13:24:48 

KEK 

22-Apr-87 

11:32:26 

kek 

14-Apr-87 

15:31:38 

RDH 

17-Feb-87 

15:06:57 

JAC 

23-Jan-87 

12:34:45 

KEK 

26-Sep-86 

13:55:42 

kek 

23-Jun-86 

16:48:47 

kek 

27-May-86 

13:18:20 

: - kek 

l2-May-86 

12:52:08 

J PM 

20-Aug-85 

12:46:45 

JPM 

12-Aug-85 

14:31:53 

JPM 

5-Aug-85 

14:05:18 

; JPM 

29-Jul-85 

11:22:59 

JMM 

20-Jun-85 

10:16:05 

; — JMM 

4-Apr-85 

15:33:07 

JMM 

20-Feb-85 

10:24:19 

NAME 

MesaVM 


$NOLIST 
$INCLUDE 

(HardDefs.asm) 

$INCLUDE 

(IOPDefs.asm) 

$INCLUDE 

(ROMEEP.asm) 

$INCLUDE 

(RAMEEP.asm) 

SINCLUDE 

(IOPMacro.asm) 

$ INCLUDE 

(VMMDefs.asm) 

SLIST 



zero out WHOLE IOR in case of not debugging with a FatlOR to support a prom image (bug!), 
add use of VMMDefs.dovePROMSize to support expanded IOR during debugging, 
add Daybreak-only MDS relief. For Daisy this is still non-MDS-relieved! 

Use masks from vmmdefs to correctly prevent display memory from being cleared. 

Initialize aChipCount for Daybreaks 
another bug in AS conversion (off-by-one) 
add ASCheckPage for multi AChip support, 
add mem zeroing stuff for parity initing, 
add new Daisy stuff 
Fix bugs in Search*Me.nory. 

Search for memory limits if EEProm bad. 

EEProm changes. 

Opie redesign conversion. 

Upgrades. 

Upgrades. 

First release. 


.*+****** ************** 

************************ ***fc**************4>******* ******** 

lOPELocalRAM 

SEGMENT AT 0 

EXTRN 

EXTRN 

EXTRN 

VMMFirstPage: WORD, VMMSizelnPages: WORD 
firstRfia 1 PanelnVM: WORD. 1 as.tRea 1 PaoeInVMj WORD 

EXTRN 

EXTRN 

EXTRN 

EXTRN 

needFatlOR 

firstDisplayBankPage: WORD, countDisplayBankPages: WORD 
IOROpieSegmentAddress: WORD 
aChipCount: BYTE 
prebootSwitches: WORD 

EQU 4000H 

lOPELocalRAM 

ENDS 

8ootStrapIOR 

SEGMENT COMMON 

EXTRN 

1oaderVirtualMemoryLocation :DWORD ;from IORRAMBt.asm 

8ootStrapI0R 

ENDS 

OpieIOR 

SEGMENT COMMON 

EXTRN 

EXTRN 

mesaPageMapOffset: WORD 
mesaPageMapSegment: WORD 

OpielOR 

ENDS 

DisplaylOR 

SEGMENT COMMON 

EXTRN 

bitMapOrg: WORD 

DisplaylOR 

ENDS 




IOPEInRAM SEGMENT PUBLIC 

PUBLIC MesaVM ;jmm:84-11-27:debug only 

Assume CS:IOPEInRAM 
Assume DS:BootStrapIOR 
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Local Constants: 


;Register equates: 


currentRealPage 

EQU 

BX 

IndexToCurrentVirtualPage EQU 

DI 

currentvirtualPage 

EQU 

SI 

request 

EQU 

SI 

savedContents 

EQU 

SI 

pagesPerBank 

EQU 

BP 

; Local Variables: 



systemMemDesc 
expans 1 onMemUe'sc 

DW 

DW 

0 

0 

sizeOfWM 

DW 

0 

locat ionOfVMM 

DW 

0 

sizeOflORegion 

DW 

0 

locat ionOflORegion 

DW 

0 

sizeOfIORegionCopy 

DW 

0 

locat ionOfIORegionCopy 

DW 

0 

sizeOfDisplayMemory 

DW 

0 

locationOfDisplayMemory 

DW 

0 

f i rs tfleal Page 

DW 

-l 

1 astRoalPa^e 

DW 

0 

countlieail P^j^ 

ow 

0 

"sizeOf Page I nBytes 

DW 

pageSIzel 

s izeOfPage InWords 

DW 

pageSizel 

localPrebootSwitches 

DW 

0 


From EEPROM 
From EEPROM 

Calculated from EE p ROM entry 
depends on machine type & mem size 
fixed {for now) 
depends on machine type 
these are needed for formatting 
the virtual lORegion 
From EEPROM 

depends on machine type 
found during VMM load 
found during VMM load 
found during VMM load 

nBytes 
nWords 


-- Virtual Memory Initialization: 

- Assume the following upon entry into this procedure; 


Information: Pilot uses the virtual memory map (VMM) to 

figure out how much memory it has got. We therefore need to 
enter all the memory available for Pilot's use into the VMM. 
Note that this would therefore preclude display memory and of 
course the memory occupied by the VMM itself, i.e. All memory 
is mapped except display memory and the virtual memory map. 
Display memory ends up being mapped by "UserTerminalHeadDove" 


Further so that the IOP does not have to go through the VMM 
to access real (this was not even physically possible with 
the DLion) memory the lORegion (IOPage in Dlion) is at a 
well known location in real memory and also in a well known 
location in virtual memory. 


Upon exiting this procedure the following will be true: 


mesaVMMMapRegister = beginning of 128KbBank containing 
the VMM. 

loaderVirtualMemoryLocation = 24-bit Opie address of 
type "mesaLogicalPageOpieAddress" 
where the Germ is to be loaded. 


MesaVM PROC FAR 

EnterMesaVM; 


%ReadEEProm(eePromLowMem,1) 
JNC StoreLowMemOesc 

CALL SearchLowMemory 

StoreLowMemOesc: MOV CS: systemMemDesc. AX 

%ReadEEProm(eePromHighMem,1) 
JNC MakeHighMemDesc 



CALL 

SearchHighMemory 

MakeHighMemDesc: 

MOV 

CX, 16 


SUB 

CX, AX 


MOV 

AX, OFFFFH 


JS 

StoreHighMemDesc 


SHR 

AX, CL 

StoreH ighMemDesc: 

MOV 

CS: expansionMemDe; 


MOV 

AX, IOPELocalRAM 


MOV 

ES, AX 


ASSUME 

ES:IOPELocalRAM 


%ReadEEProm(eePromMemSize,: 


JNC 

CalcSizeOfVMM 


MOV 

AL, 1 

CalcSizeOfVMM: 

AND 

AL, 3 


MOV 

CL, AL 


; if can’t trust EEPROM, 
: try to figure it out 


if can't trust EEPROM, 
try to figure it out 
each count in AX 
becomes one bit 
in mem desc word 
(up to 16) 


; jmm:84 - 12-26:MakeWordForVMMPageCount 
;if can't trust EEPROM. 

;use 22 bit VM 
;get encoded VM size 
; prepare to shift 
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MOV AX, 32 ;calculate number 

SHL AX, CL ;of VMM pages 

MOV CS: sizeOfVMM, AX ;and store 

MOV VMMSizelnPaqes , AX 

MOV AX , prebootSwitches 

MOV CS: localPrebootSwitches. AX 


InitialIzeVMMSetUpVariables: 

TEST 

JNZ 

skinnylOR: MOV 

MOV 
JMP 

fattenlOR: MOV 

MOV 

doneWithlGR: 


CS: localPrebootSwitches, needFatlOR 
fattenlOR 

CS: sizeOflORegion, doveSlimlORegionSize 
CS: sizeOflORegionCopy, doveSlimIORegionSize 
doneWithIOR 

CS: sizeOflORegion, doveFatlORegionSize 
CS: sizeOflORegionCopy, doveFatlORegionSize 


DaisyInitialization: 
SI imDaisyVariables: 


FatOaisyVariables: 


;We need to know what 
;machine we are on because 
;VMM, IORegion and display 
;are in different places for 
idlfferent configurations. 


IN AX, machinelDPort 

AND AX, machineIDMask 

CMP AX, Daisy 

JE Daisylnitialization 

JMP Daybreaklnitialization 

CMP CS: expansionMemDesc, 0 

JNZ FatDaisyVariables 

MOV CS: 1ocationOfVMM, siimDaisyVMMBasePage 

MOV VMMFirstPage, siimDaisyVMMBasePage 

MOV CS: locationOflORegion, siimDaisylORegionBasePage 
MOV CS: locationOflORegionCopy, siimDaisylORegionBasePage 
MOV CS: locationOfDisplayMemory, siimDaisyDisplayBasePage 
MOV firstOisplayBankPage, siImDaisyDisplayBasePage 

MOV CS: sizeOfDisplayMemory, siimDaisyDisplayMemSize 
MOV countDisplayBankPages, siimDaisyDisplayMemSize 

AND CS: systemMemDesc, slimDaisyDisplayDescMask 'don't put display mem 

the AChip was originally programmed assuming a bitMapOrg of zero, 
as would be the case for fatDaisy. Since it is slimDaisy, 
it must be reprogrammed. 

Note that I am NOT copying the bitMap contents to the new bitMapOrg. 

As a consequence, the bitmap will display trash after this executes. 

ES 

DisplaylOR ;display IOR bitMapOrg. 

AX 

DisplaylOR 
bitMapOrg, 768 


PUSH 

MOV 

MOV 

ASSUME 

MOV 

POP 

ASSUME 
MOV 
MOV 
OUT 
MOV 
MOV 
MOV 
JMP 
MOV 
MOV 
MOV 
MOV 
MOV 
MOV 
MOV 
MOV 
AND 


AX, 

ES, 

ES: 

ES: 

ES 

ES: 

DX, 

AX, 

DX, 


;set actual aChlpCount. 

;(for later display bitmap zeroing) 


IOPELocalRAM 

OBCOH ;AChip.BaseP bitMapOrg. 

OCOOOH 
AX 

aChlpCount, 1 

DX, siimDaisyDisplayBasePage 
BP, siimDaisyDisplayEndPage 
F1ndDaisyOlsplaySize 
CS: locationOfVMM, fatDaisyVMMBasePage 
VMMFirstPage, fatDaisyVMMBasePage 
CS: locationOflORegion, fatDaisylOReg ionBasePage 
CS: locationOflORegionCopy, fatDaisylORegionBasePage 
CS: locationOfDisplayMemory, fatDaisyDisplayBasePage 
firstOisplayBankPage, fatDaisyDisplayBasePage 
countDisplayBankPages, fatDgisyDisplayMemSize 
CS: sizeOfDisplayMemory, fatDaisyDisplayMemSize 

CS: systemMemDesc, fatDaisyDisplayDescMask ;don’t put display mem 

the AChip was originally programmed assuming a one-ASID situation, 
there is more than one AID, it they must be reprogrammed for more 


Since 


: than 

one ASID. 


MOV 

DX, 

082EH 

;AIDO <- ASIDE 

MOV 

AX, 

OOOIH 


OUT 

DX, 

AX 


INC 

DH 


;AIDE «- ASIDO 

DEC 

AX 



OUT 

OX. 

AX 


INC 

DH 


; AID2 +■ ASID2 

MOV 

AX, 

0002H 


OUT 

DX, 

AX 


INC 

DH 


;AID3 «- ASID3 

MOV 

AX, 

0003H 


OUT 

DX, 

AX 


MOV 

DX, 

fatDaisyDisp 

layBasePage 

MOV 

BP, 

fatDaisyDisplayEndPage 

MOV 

AX, 

CS: expansionMemDesc 


:(for later display bitmap zeroing) 
;calculate actual aChipCount. 


FindDaisyDisplaySize: 


Daybreaklnitialization: 


MOV 

SHR 

JZ 

INC 

SHR 

JZ 

INC 

IN 

AND 

CMP 

JMP 

MOV 

MOV 

MOV 

MOV 

MOV 


2 chips! 


aChlpCount, \ 

AX, 4 

FIndDaisyDisplaySize 
aChipCount ; 3 chips! 

AX, 4 

FindDaisyDisplaySize 
aChipCount : 4 chips! 

AL, DaisyDisplayTypePort 
AL, OaisyDisplayTypeMask 
AL, Daisynineteenlnch 
SHORT DisplaySizeFound 

CS: locationOfVMM, fatDaybreakVMMBasePage 
VMMFirstPage, fatDaybreakVMMBasePage 
CS: locationOflORegion, fatDaybreaklOReg ionBasePage 
CS: locationOflORegionCopy. fatDaybreaklORegionBasePage 
CS: locat ionOfDisplayMemory, fatDaybreakDisplayBasePage 


in VM 


in VM 
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MOV 

MOV 

TEST 

MOV 

JNZ 

MOV 

MOV 

JMP 

FatDaybreakVariables: MOV 

MOV 

FindDaybreakDisplaySize:MOV 
IN 
MOV 
MOV 
TEST 


aChlpCount, 0 ;daybreak has no a chips 

firstOisplayBankPage, fatDaybreakDIsplayBasePage 
CS: systemMemOesc, OFCH 

BYTE PTR CS: systemMemOesc, 0 :don't put display mem in VM 
FatDaybreakVariables 

CS: sizeOfDisplayMemory, si imDaybreakDisplayMemSize 
countDisplayBankPages, siimDaybreakDisplayMemSize 
SHORT FindDaybreakDIsplaySize 

CS: sizeOfDisplayMemory, fatDaybreakDisplayMemSize 
countDisplay8ankPages, fatDaybreakDisplayMemSize 
DX, DisplayTypePort 
AL, DX 

DX, fatDaybreakDisplayBasePage:(for later display bitmap zeroing) 
BP, fatDaybreakDisplayEndPage 
AL, DisplayTypeMask 


zero memory from end of display bitmap to end of display memory bank, 
enter here with start of display bitmap in DX. and the zero flag set if 19", 
oh, also BP needs t 
DisplaySizeFound: 

siImDisplay: 

fatDisplay: 

InitDisplayMemory: 


MemorySIzeFound: 

setUpSmal1IOR: 
setUpFatlOR: 


>e pointing to the last page of the 

JZ 

fatDisplay 

ADD 

DX, pagesForl5InchDisplay 

JMP 

InltDisplayMemo ry 

ADD 

DX, pagesForlSInchDIsplay 

MOV 

AX, DX 

CALL 

ZeroPage 

INC 

DX 

CMP 

DX, BP 

JB 

InitDisplayMemory 

TEST 

CS: localPrebootSwitches, 

JNZ 

setUpFatlOR 

MOV 

BX, (doveS1imIORegionSize 

JMP 

IORSetUp 

MOV 

BX, ((doveFatlORegionSize- 


needFatlOR 


-.word count 


dovePROMSize is subtracted from the lORegionSize above so that any 
debugging prom image present is not erased, in the setUpFatlOR case, 

In the setUpSmal1IOR case, of course, there is no prom image present since it is 
not a debugging session by definition...! 


IORSetUp: 


ZeroIOR: 


MOV DX, CS: locationOflORegion 

MOV CX, (extendedBusPageOpieAddress SHL 8) 

%E$tablishIOPAccess(IORegionMapRegister.CX-DX) 
ASSUME ES:NOTHING 


MOV 

XOR 

CLD 

REP 

MOV 

MOV 


CX, BX 
AX, AX 


STOSW 
DX. CS: 


; the size of IOR to be O'ed. 


1ocationOfVMM 

CX, (extendedBusPageOpieAddress SHL 8) 
%Establi$hIOPAccess(mesaVMMapRegister.CX-OX) 
ASSUME ES:NOTHING 


StampAl1PagesVacant: 
StampAliPgsThisPg: 


StayInThis64Kb8ank: 


PUSH ES 

PUSH DI 

MOV CX. CS: SizeOfVMM 

MOV DX, pageSizelnWords 

MOV WORD PTR ES: [IndexToCurrentVirtualPage], (pageVacantMask SHL 8) 

INC IndexToCurrentVirtualPage 

INC IndexToCurrentVirtualPage 

JNZ StaylnThls64KbBank 

MOV AX, ES 

ADD AX, crossover64KbBank 

MOV ES. AX 

DEC DX 

JNZ StampAllPgsThisPg 

LOOP StampAllPagesVacant 

POP DI 

POP ES 


PUSH 

PUSH 

MOV 

MapSystemPages: MOV 

MOV 
MOV 

ChecklfDone: CMP 

JNE 
JMP 

ChecklfThisBankPresent: MOV 
RCR 
JC 
ADD 
JMP 


ES 

DI 

currentVirtualPage, 0 

currentRealPage, 0 

DX, CS: systemMemDesc 

pagesPerBank, numberOfPagesIn64Kb8ank 

DX, 0 

ChecklfThisBankPresent 
IsVMSetUpDone 
CX, pagesPerBank 
DX, 1 

PageMappingLoop 
currentRealPage, CX 
ChecklfDone 


;no more units 

;number of pages in a ban 

ifound a bank 
;skip over this bank 


PageMappingLoop: 


SkipPartOfArea: 


CMP currentRealPage, CS: 1ocationOfVMM 

JNE IsltDisplayMemRealPage 

CMP CX. CS: sizeOfVMM 

JGE SkipVMM 

ADD CS: 1ocationOfVMM, CX 

SUB CS: sizeOfVMM, CX 

ADD currentRealPage. CX 
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SizeOfVMM 


SkipVMM: 

ShouldWeContinue: 
IsIt.DisplayMemRealPage: 

SklpDisplay; 
IsItlORegionRealPage: 

SkipIORegion: 

;this is here to shorten 
GoToNextPage: 

IsItlORegionVIrtualPage: 

needSlimIORVM: 

needPatlORVM: 

donelORVM: 

MapIORegion: 


KeepMapping: 


StayInCurrent64KbBank: 


IsVMSetUpDone: 


VMSetllpOone: 


JMP ChecklfOone 

ADO currentRealPage, CS: 

SUB CX, CS: SizeOfVMM 

JNZ PageMappingLoop 

JMP CheckIfDone 

CMP currentRealPage, CS: locationOfDisplayMemory 

JNE IsItlORegionRealPage 

CMP CX, CS: SizeOfDisplayMemory 

JGE SkipOisplay 

ADO CS: TocationOfDisplayMemory, CX 

SUB CS: sizeOfDisplayMemory, CX 

JMP SkipPartOfArea 

ADD currentRealPage. CS: sizeOfDisplayMemory 

SUB CX, CS: sizeOfDisplayMemory 

JMP ShouldWeContinue 

CMP currentRealPage, CS: locationOfIORegion 

JNE IsItlORegionVirtualPage 

CMP CX, CS: sizeOfXORegion 

JGE SkipIORegion 

ADD CS: locationOfIORegion, CX 

SUB CS: sizeOflORegion, CX 

JMP SkipPartOfArea 

ADD currentRealPage, CS: sizeOfIOReg ion 

SUB CX, CS: sizeOflORegion 

JMP ShouldWeContinue 

the backward jumps 
INC currentVirtualPage 

INC currentRealPage 

INC countRealPages 

LOOP PageMappingLoop 

JMP ChecklfOone 


TEST CS: 1ocalPrebootSwitches, needFatlOR 

JNZ needFatlORVM 

CMP currentVirtualPage, siimIORegionFirstVirtualPage 
JMP donelORVM 

CMP currentVirtualPage, fatlORegionFirstVirtualPage 

JNE KeepMapping 

PUSH currentRealPage 

PUSH CX 

MOV CX, CS: sizeOflORegionCopy 

MOV currentRealPage, CS:1ocationOflORegionCopy 


MOV AX, currentRealPage 

OR AX, (pagePresentMask SHL 8) 

CALL ASCheckPage 

MOV ES: [IndexToCurrentVirtualPage], 

INC IndexToCurrentVirtualPage 

INC IndexToCurrentVirtualPage 

INC currentRealPage 

INC currentVirtualPage 

INC CS: countRealPages 

LOOP MapIORegion 

POP CX 

POP currentRealPage 

MOV AX, currentRealPage 

CALL ZeroPage 

OR AX, (pagePresentMask SHL 8) 

CALL ASCheckPage 

MOV ES: [IndexToCurrentVirtualPage], 

INC IndexToCurrentVirtualPage 

INC IndexToCurrentVirtualPage 

JNZ StayInCurrent64KbBank 

MOV AX. ES 

ADD AX, cro$SOver64KbBank 

MOV ES. AX 


;the map and a (2) 3 bit mask. 

AX ;() for large memory machines 
{Point to the next virtual 
{page and also to the next 
;real page. 


;We had saved this page. 

{into the VMM and mask them 

:the map and a (2) 3 bit mask. 

AX ;(} for large memory machines 
;Byte swap was for mesa! 

{Point to the next virtual 
.page and also to the next 
:reai page. Don't forget to 
{test for end of real memory. 


MOV CS: lastRealPage, currentRealPage 

CMP CS: firstRealPage, -1 

JNE GoToNextPage 

MOV CS: firstRealPage, currentRealPage 

JMP GoToNextPage 

CMP pagesPerBank, numberOfPagesIn256KbBank 
JE VMSetUpDone 

MOV currentRealPage, numberOfPagesInOneMb 

MOV DX, CS: expansionMemDesc 

MOV pagesPerBank, numberOfPagesIn256KbBank 

JMP ChecklfDone 


MOV AX, IOPELocalRAM 

MOV ES, AX 

ASSUME ES:IOPELocalRAM 
MOV AX, CS: firstRealPage 

MOV firstRealPagelnVM, AX 

MOV AX, CS: lastRealPage 

MOV 1astRealPagelnVM, AX 

MOV AX, CS: countRealPages 

MOV countRealPagesInVM, AX 

IN AX, machinelDPort ;the following MDS-relief 

AND AX, machinelDMask ; stuff is for Daybreak only. 
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CMP AX, Daisy 

JE InitialIzeDaisyGermVM 

Initia1izeDayb reakGe rmVM: 

;(For MDS relief, we first load a one-page GET into 
; the page before the germ. Germlnit will move it later.) 

MOV WORD PTR 1oaderVirtualMemoryLocation[0], loaderVirtualPage 

JMP VMSetUpQoneContinued 


InitialIzeDaisyGermVM: 
VMSetUpDoneContinued: 


MOV 

MOV 


WORD PTR loaderVirtualMemoryLocation[0], germVirtualPage 

WORD PTR loaderV1rtualMemoryLocation[2], (mesaLogicalPageOpieAddress 

;A virtual address 
;has the page value appearing in 
;the low sixteen bits of the 
;address. Here we forward the 
;Germ'$ virtual address. 


MOV ES, lOROpieSegmentAddress 

ASSUME ES:OpieIOR 

POP mesaPageMapOffset 

POP mesaPageMapSegment 


SHL 8) 


RET 


MesaVM ENDP 

ASSUME ES:NOTHING 


;This zeros out the page of real memory pointed to by AX. 

:This proc is used to initialize all non-special memory 

; (non-display-bitmap/non-VMM/non-IOR). This is needed to make sure all memory that 
; wil'l be used by Pilot later on has been pre-touched, to ensure that the parity 
; bit of all non-special memory is inited to show no parity errors. IE, this code 
: prevents parity errors on these pages if they are ever read-accessed before they 
: are written. 


ZeroPage: 


PUSHA 

PUSH ES 

MOV DX, AX 

MOV CX, (extendedBusPageOpieAddress SHL 8) 

%EstablishIOPAccess(generaIMapRegister.CX-DX) 
MOV CX, pageSizelnWords 

XOR AX. AX 

CLD 

REP STOSW 
POP ES 

POPA 
RET 


;This adapts the page number in AX about to be mapped to the Daisy A-S 
; interface **if applicable**. 


IF the machine is a Daisy. AND the machine has more than one AChip, 

AND the page address is within the first two megabytes of real memory, 

THEM the rules of the Achip-Schip interface apply. 

If applicable, then if the page address is in the first meg then add 1M to it 
else if the page is in the second meg of address space then subtract 1M from it. 

This accomodation to the AS Interface is necessary to make the pages mapped 
in the VMM match the backwards Schip point of view. The reverse of these reversals 
is clone in IOPLMap.ConvertAddress in Opie when it reads pages from the VMM. 


ASCheckPage: 

PUSH 

ES 



PUSH 

AX 



XOR 

AX, AX 



MOV 

ES, AX 



ASSUME 

ES:lOPELocalRAM 



POP 

AX 



CMP 

ES:aChipCount, 1 

:(0 = >Daybreak ) 


JBE 

ASCheckPageOone 

: i t' 3 a mu 11 chip 


;add 1Mb if real addr in 

first meg. 

ASTestFirstMeg: 

CMP 

AX. 7FFH 

;IMeg in pages 


JA 

ASTestSecondMeg 



ADD 

AX, 800H 



JMP 

ASCheckPageOone 



;sub 1Mb if real addr in 

second meg. 

ASTestSecondMeg: 

CMP 

AX, 1000H 

;3Meg in pages 


JAE 

ASCheckPageOone 



SUB 

AX, 80QH 


ASCheckPageOone: 

POP 

ES 



ASSUME 

ES:NOTHING 



RET 



SearchLowMemory 

PROC 

NEAR 


; Figure out what banks are present in the first 

1MB 

; Algorithm: 




; Assume bank 0 

is good. 

since it exists or 

all configurations 

: Look at first 

and last 

page of each bank 

(128 pages/bank) 


See if memory will return value stored 

See if bank 0 clobbered by store (incomplete decoding) 

Check banks 1-15 
Return good bank mask in AX 

MOV SI, 8000H ;assume bank 0 present 

MOV OX, 0 
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MOV 

CX, (extendedBusPageOpieAddress SHL 8) 


%Establi$hIOPAccess(mesaVMMapRegi$ter,CX-DX) ; 


MOV 

WORD PTR ES:[DI], 0 


MOV 

BP. ES 


MOV 

currentReal Page, number0fPagesIn64KbBank 

CheckThisLowBank: 

SHR 

SI. 1 


MOV 

DX , currentRea1 Page 


MOV 

CX, (extendedBusPageOpieAddress SHL 8) 


%Establ1shI0PAccess(generalMapRegis ter ,CX-DX) 


MOV 

WORD PTR ES:[DI], 0 


CMP 

WORD PTR ES:[DI], 0 


JNE 

LowBankNotPresent 


MOV 

WORD PTR ES:[DI], OFFFFH 


CMP 

WORD PTR ES:[DI], OFFFFH 


JNE 

LowBankNotPresent 


MOV 

ES, BP 


CMP 

WORD PTR ES:[DI], 0 


JE 

CheckThisLowBankLastPage 


MOV 

WORD PTR ES:[DI], 0 


JMP 

SHORT LowBankNotPresent 

CheckThisLowBankLastPage: 



MOV 

DX, currentRealPage 


ADD 

DX, numberOfPagesIn64KbBank-l 


MOV 

CX, (extendedBusPageOpieAddress SHL 8) 


%Establ 

ishIOPAccess(generalMapRegister.CX-DX) 


MOV 

WORD PTR £S:[DI] , 0 


CMP 

WORD PTR ES:[DI], 0 


JNE 

LowBankNotPresent 


MOV 

WORD PTR ES:[DI], OFFFFH 


CMP 

WORD PTR ES:[DI ], OFFFFH 


JNE 

LowBankNotPresent 

LowBankPresent: 

OR 

SI, 8000H 

LowBankNotPresent: 

ADD 

currentRealPage, numberOfPagesIn64KbBank 


CMP 

currentRealPage, numberOfPagesInOneMb 


JB 

CheckThisLowBank 


MOV 

AX, SI 


RET 


SearchLowMemory 

ENDP 


SearchHighMemory 

PROC 

NEAR 

; Figure out what banks are present after the first 1MB 

; Algorithm: 



; Look at first 

and last 

page of each bank (512 pages/bank) 

; See if memory 

will return value stored 

; Stop at first 

failure or address - 4MB, whichever comes first 

; Return bank count in AX 



MOV 

currentRealPage, numberOfPagesInOneMb 


MOV 

SI, 0 

CheckThisHighBank: 

MOV 

DX, currentRealPage 


MOV 

CX, (extendedBusPageOpieAddress SHL 8i 


%EstablishIOPAccess(generalMapRegister,CX-DX) 


MOV 

WORD PTR ES:[DI]. 0 


CMP 

WORD PTR ES:[DI] , 0 


JNE 

HighBankNotPresent 


MOV 

WORD PTR ES:[DI], OFFFFH 


CMP 

WORD PTR ES : [DI], OFFFFH 


JNE 

HighBankNotPresent 


MOV 

DX. currentRealPage 


ADD 

DX, numberOfPagesIn256KbBank 1 


MOV 

CX, (extendedBusPageOpieAddress SHL 8) 


%EstablishIOPAccess(genera 1MapRegister,CX-DX) 


MOV 

WORD PTR ES;[DI], 0 


CMP 

WORD PTR ES:[DI], 0 


JNE 

HighBankNotPresent 


MOV 

WORD PTR ES:[DI], OFFFFH 


CMP 

WORD PTR ES.[DI], OFFFFH 


JNE 

HighBankNotPresent 


INC 

SI 


ADD 

currentRealPage. numbe rOfPagesin256Kb Bank 


CMP 

currentRealPage, hardwareMaxRea!Page 


JB 

CheckThisHighBank 

HighBankNotPresent: 

MOV 

AX, SI 


RET 


SearchHighMemory 

ENDP 


IOPEIriRAM 

ENDS 



END 
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;Copyr1ght (C) 1984, 1986 by Xerox Corporation. All rights reserved. 


stored as [Iris]<WM1cro>Dove>VMMDefs.asm 
-- It uses IORegion locations of the bootstrap handler. 

-- last edited by: 



KEK 

22-Apr-87 

11:31:14 

__ 

kek 

14-Apr-87 

15:31:38 

-- 

RDH 

30-Jan-87 

18:07:37 

and 

slimDaisyDisplayDescMask to 

not map Display ban 

-- 

KEK 

27-May~86 

14:12:41 

-- 

KEK 

6-May-86 

21:09:52 

-- 

J PM 

3-Aug~85 

9:01:07 

— 

RDH 

2-Aug -85 

12:33:23 

-- 

JPM 

29-Jul-85 

9:58:31 

-- 

RDH 

24-Jul-85 

15:03:18 

__ 

JMM 

22-Jul-85 

15:02:29 


JMM 

20-Jun-85 

15:54:51 

-- 

JPM 

29-May-85 

12:48:13 

-- 

JMM 

4-Apr-85 

15:46:44 

-- 

JMM 

4-Jan-85 

17:24:58 


;add dovePROMSize to support expanded IOR during debugging. 

:add Daybreak only MDS relief. For Daisy this is still non-MDS-relieved! 

;Change fatDaisyDisplayMemSize to 1024 from 266, and add fatDaisyDisplayDescMask 
correctly. 

;add *displayEndPage defs. 

;update Daisydefs to current. 

;Add numberOfPagesIn256KbBank and numberOfPagesInOneMb. 

;Added hardwareMaxRealPage to fix MEB prob. 

;Add labels to floppy germ request STRUC. 

:Removed magic numbers from floppy germ request. 

;Fixed floppy germ request. 

;Alt etherboot support. 

•.Diagnostic boot changes. 

:Misc. updates. 

;First release. 


NAME VMMDef S 


For both Daisy and Daybreak, the virtual memory map is hardwired 

at main memory location 0-jmm:84-12-27:Fixlnfo. Also the IORegion is loaded in a well 

known real and virtual memory location (i.e. if it is decided to 

load it into real memory location "x" and virtual memory location 

"y", then the virtual memory map has to show that virtual memory 

location "y" is mapped to real memory location "x". The Germ as 

stipulated in the PrinceOps gets loaded starting at virtual page 

256 and its request section starts at virtual page 288. 


germVirtualPage 

EQU 

0001H 


gerniRequestVirtual Page 

EQU 

0003H 


ethernetBootFileMask 

EQU 

000400 


gftVirtualPage 

EQU 

0200H 

;used by 

loaderVirtualPage 

EQU 

germVirtualPage 

- 1 :used by 

location 

EQU 

0 


value 

EQU 

2 


;Ethernet, Disk. Floppy. 

RS232C 

boot constants locations; 


sFirstGermRequest 


EQU 00A0H ;(start of germ request in SD} 


RequestQversion 

Request@action 

Request@location@deviceType 

Request@1ocation@devGrd 


EQU 

(sFirstGermRequest 

+ OOH )*2 

idouble CP address 

EQU 

(sFirstGermRequest 

+ 01H )*2 

lvalue to get IOP 

EQU 

(sFirstGermRequest 

i- 02H)*2 

: address. 

EQU 

(sF 1 rstGermRequest 

+ 03H)*2 



e theme tBootFi 1 eNumberOQlocation 
ethernetBootFi1eNumberl@location 
etherne tBootFileNumber2@location 


EQU (sFirstGermRequest + 04H)*2 
EQU (sFirstGermRequest + 05H)*2 
EQU (sFirstGermRequest *- 06H)*2 


ethernetNetworkNumberO@location 
ethernetNetworkNumberlQlocation 


EQU (sFirstGermRequest + 07H)*2 

EQU (sFirstGermRequest + 08H)*2 


ethernetHostNumberO@Request@location 
ethernetHostNumberl@Request@location 
ethernetHostNumber2@Request@location 

ethernetSocket@Request@location 

Request@location@cyl1nder@diskFi1eID@da 

Request@location@headSector@diskFileID@da 


EQU 

(sF i rstGermRequest 

+ 09H )*2 

EQU 

(sFirstGermRequest 

+ OAH)*2 

EQU 

(sF irstGermRequest 

+ 0BH)*2 

EQU 

(sFirstGermRequest 

+ GCH)*2 


EQU ( sF irstGermRequest +■ 09H)*2 

EQU ( sF irstGermReques t 0AH)*2 


Request@floppyLocation@cylinder EQU (sFirstGermRequest + 0BH)*2 
Request@floppyLocation@headSector EQU (sFirstGermRequest + 0CH)*2 


Ethernet, Disk, Floppy, RS232C boot constants: 


RequestVersion 
bootPhysicalVolume 
bootFloppyPhysicalVo1ume 
inLoad 

germEthernet 
germPi 1otDisk 
DeviceTypes@sa800 
ethernetDeviceOrdinal 

ethernetBootFileNumberHigh 
ethernetBootFileNumberMiddle 
ethernetBootFi1eNumberLow 


EQU 

034560 


EQU 

2 

:request action for disk 

EQU 

0 

;request action for floppy 

EQU 

0 

;request action for ethernet 

EQU 

6 

:boot device for ethernet 

EQU 

64 

;boot device for disk 

EQU 

1 

;boot device for floppy 

EQU 

0 


EQU 

0000000 


EQU 

1250000 


EQU 

0040400 
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ethernetBootNetworkNumberHIgh 

EQU 

0 

ethernetBootNetworkNumberLow 

EQU 

0 

ethernetHostNumberHigh 

EQU 

OFFFFH 

ethernetHostNumberMiddle 

EQU 

OFFFFH 

ethernetHostNumberLow 

EQU 

OFFFFH 

ethernetBootSocket 

EQU 

OOOOAH 

onlyFloppy 

EQU 

0 

;The parameters below are byte-swapped 

for Mesa. 



%*DEFINE (ByteSwap (wordToSwap)) 

(%wordToSwap SHL 8 OR %wordToSwap SHR 8) 


DiskGermVarlables STRUG 

DW RequestQversion. "/.ByteSwap (RequestVersion) 

DW RequestQaction. "/.ByteSwap (bootPhysicalVolume) 

DW Request®!ocationQdeviceType, %ByteSwap (germPIlotDisk) 

DW Request®location®devOrd , "/.ByteSwap (0) 


DIskGermVariables ENDS 


EthernetGermVariables STRUC 

DW 

DW 

OW 

DW 

boot.F il eNumberHIgh OW 

bootFileNumberMiddle DW 

boot.FIl eNumberLow DW 

DW 
DW 
OW 
OW 
DW 
DW 

EthernetGermVariables ENDS 


Reque$t@version, %ByteSwap (RequestVersion) 

Request@action, %ByteSwap (inload) 

Request@location@deviceType, %8yteSwap (germEthernet) 

RequestQlocationQdevOrd , %ByteSwap (ethernetDevIceOrdinal) 
ethernetBootFileNumberOQlocation, "/.ByteSwap (ethernetBootFileNumberHigh) 
ethernetBootFileNumberl®location, "/.ByteSwap (ethernetBootFileNumberMiddle) 
ethernetBootFileNumber2@location, "/.ByteSwap (ethernetBootFi1eNumberLow) 
ethernetNetworkNumberOQlocation , "/.ByteSwap (ethernetBootNetworkNumbe rHigh) 
ethernetNetworkNumberlOlocation, “/.ByteSwap (ethernetBootNetworkNumberLow) 
ethernetHostNumberO@Request®!ocation, %ByteSwap (ethernetHostNumberHigh) 
ethernetHostNumberl@Request@l ocat ion , /.ByteSwap (ethernetHos tNumbe rM i ddl e) 
ethernetHos tNumbe r2@Request@l ocat ion , "/.ByteSwap (ethernetHostNumberLow) 
ethernetSocketSRequest®location, "/.ByteSwap (ethernetBootSocket) 


FloppyGermVariables STRUC 


DW 

DW 

DW 

DW 

bootFileCylinder DW 

bootFi1eHeadAndSector DW 


RequestQversion, %ByteSwap (RequestVersion) 

Request@action, “/.ByteSwap (bootFloppyPhysicalVolume) 
Request®!ocationQdeviceType, %ByteSwap (DeviceTypes®sa800) 
Request@location®devOrd, "/.ByteSwap (onlyfloppy) 

Request@floppyLocation@cy!inder, 0 
RequestQfloppyLocationSheadSector, 0 


FloppyGermVariables ENDS 


: BootTimeVariables 

STRUC 


; device 

DW 

? 

;mode 

DW 

? 

;showUserInterface 

DW 

? 

ibootRetryCount 

DW 

? 

:reincarnationFlag 

DW 

? 

;emulatorlD 

DW 

3 DUP(?) 

:loaderlD 

DW 

3 DUP(?) 

;diagnostlcsType 

DW 

? 


; B o o tTimeV ariables ENDS 


Device types: 


disk 

EQU 

1 

floppy 

EQU 

2 

ethernet 

EQU 

3 

rs232C 

EQU 

4 


:1-Disk, 2-Ethernet, 3-Floppy, 4-RS232C. 
;0-Normal, 1-Fast boot 
;0-yes, #0-no. 

; initially 0, incremented per failure 

;For task re initialization - 0 => tasks 
;to use local RAM otherwise main memory. 

;Initially 0, updated by boot executive. 
;Initial ly 0, updated by boot executive. 

initialized at boot-time. 0 => short 
;diagnostics - user has set EEPROM to 
indicate desire for a diagnostics boot. 
;#0=> long diagnostics boot - user has 
;manualiy requested diagnostics at boot 
;time! 
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Boot types: 


normal EQU 0 

diagnostic EQU 1 


;Virtual Memory Constants: 

max imusnPageNumbe r 
pageSizelnBytes 
pageSizelnWords 

;firstDovePage 
f1rstDovePage 
firstDaisyPage 
firstSlimDaybreakPage 

fatDaybreakVMMBasePage 
fatDa isyVMMBasePage 
siimDaisyVMMBasePage 


fatDaybreaklORegionBasePage 
siimDaybreaklORegionBasePage 
fatDaisyIQRegIonBasePage 
si iroOaisylORegionBasePage 

doveFirstBankCei1ing 

dovePROMSize 

doveSlimIORegionSize 

doveFatlORegionSize 

siimIGRegionFIrstvirtualPage 

fatlORegionFirstVirtualPage 


doveDisplayBasePage 
fatDaybreakDisplayBasePage 
si imDaybreakDIsplayBasePage 
fatDaIsyDisplayBasePage 
siimDaIsyDisplayBasePage 

;formula for the display-pages 
bitsPerWord 
pagesForl9InchDisp1ay 
pagesForl5InchD1splay 

fatDaybreakDisplayMemSize 
siimDaybreakDisplayMemSize 
dalsyDisplayMemSize 
fatDaisyDlsplayMemSIze 
siImDaisyDisplayMemSize 
fatDaisyDisplayDescMask 
s1imDaisyDisplayDescMask 

fatDaybreakOisplayEnd Page 
fatDaisyDIsplayEndPage EQU 
siimDaisyDIsplayEndPage EQU 


EQU 

2000H 

;A 4Mbyte machine has this many pages 

EQU 

0200H 

-.That is 512 bytes per page which 

EQU 

OlOOH 

:is 256 words per page. 

EQU 

0 

;A11 Dove Main memory start at 

EQU 

1024 

;jmm:85-01-17:tmpFIX!!! 

EQU 

0 


EQU 

1024 


EQU 

1024 

;In decimal page numbers. 

EQU 

2048 

: 1M from IOPside = 0 from SChipside, 

EQU 

0 


EQU 

1312 

;In decimal page numbers. 

EQU 

1312 


EQU 

2336 

; In decimal page numbers. 

EQU 

288 


EQU 

256 

;jmm:84-12-10In decimal page 

EQU 

32 

;In decimal page numbers 

EQU 

64 

;jmm:84-12-10:numbers . 

EQU 

doveSlimIORegionSize+dovePROMSize 

EQU 

doveFirstBankCeiling-doveSlImIORegionSize 

EQU 

doveFirstBankCeiling-doveFatIORegionSize 



;jmm:84-12-10:fixAfterDemo. 


EQU 

0 

;In decimal page numbers. 

EQU 

0 

;In decimal page numbers. 

EQU 

0 

; jmm:84-12-04:UntilGAPmoves 

EQU 

0 


EQU 

768 



calculation taken from UserTerminalHeadDove 


EQU 

16 


EQU 

(l152/bitsPerWord*86l+pageSizeInWords-l)/pageSizelnWords 

EQU 

(832/bit 

sPerWord*633+pageSizeInWords-1)/pageSizelnWords 

EQU 

256 

;In decimal page numbers. 

EQU 

256 


EQU 

256 


EQU 

1024 

;Half a meg 

EQU 

256 


EQU 

0FF00H 

:Half a meg 

EQU 

0FF3FH 

;$ame Size as Dybrk. 

EQU 

fatDaybreakDIsplayBasePage+fatDaybreakDIsplayMemSize 


fatDaisyDisplayBasePage+fatDaisyDisplayMemSize 
siimDaisyDisplayBasePage+slimDaisyDisplayMemSize 


fatDaisy 

EQU 

0 


fatDaybreak 

EQU 

0 


numberOfPagesIn64KbBank 

EQU 

128 


numberOfPagesIn256KbBank 

EQU 

512 


numbe rOfPages InOneMb 

EQU 

2048 


hardwareMaxRea1 Page 

EQU 

numberOfPagesInOneMb * 4 - 1 ; 4 MB 

pageVacantMask 

EQU 

01100000B 

;See “Sirius Microcode Referen 

pagePresentMask 

EQU 

OOOOOOOOB 

; Vers ion 1.0 Pp . 6-1 & 6-3. 

numberOfPagesPerMapRegAccess 

EQU 

100H 

:Given that each map register 

numberOfPagesPerlndexRegAccess 

EQU 

80H 

;points to 128Kb of memory and 
;that an 80186 register can ac 
;at most 64Kb of memory. 

crossover64KbBank 

EQU 

01000H 



Convenience macros: 


%*Define (MultiplyByTwo (register)) 
(ROL ^register, 1) 
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SM0D186 

SPAGELENGTH (95) 

$PAGEWIDTH (136) 

stored as [Iris]<WMicro>Dove>GermInit.asm 
created on 28-Jan-85 14:47:51 

last edited by: 

. ** add Daybreak-only MDS relief. For Daisy this is still 

Change IOPEInRAM alignment to WORD. 

Get floppy boot file address from local RAM. 

Alt etherboot support. 

Fixed e'net device type. 

First release. 


NAME. 

Germlnit 

SNOLIST 


$ INCLUDE 

(HardDefs.asm) 

$ INCLUDE 

(IOPDefs.asm) 

SINCLUDE 

(IOPMacro.asm) 

$ INCLUDE 

(VMMDefs.asm) 

SLIST 



OpIelOR 

SEGMENT COMMON 

EXTRN 

mesaPageMapOffset: WORD 

EXTRN 

mesaPageMapSegment: WORD 

OpielOR 

ENDS 


kek 

JPM 

JPM 

JMM 

JMM 

JMM 


X4-Apr-o/ 

12-Aug-85 9:15:12 

26-Jul-85 13:40:25 
26-Jun-85 11:50:44 
16-Apr-85 18:03:17 
4 -Ad r-85 15:47:11 


non-MDS-relieved! 


lOPELocalRAM 


SEGMENT AT 0 


EXTRN 

EXTRN 

EXTRN 


device: WORD 

baseEthernetFi1elD; WORD 
floppyBootFileAddress: WORD 


IOPf! Local RAM ENDS 


IOPEInRAM SEGMENT WORD PUBLIC 

PUBLIC Germlnit 

Assume CS:IOPEInRAM 


Local Constants: 


;Register equates: 

request EQU SI 

;Local Variables: 


germRequestlnit 


DW unknownInitRequest. DisklnitRequest, FloppylnitRequest 

DW EthernetlnitRequest, EthernetlnitRequest 


diskGermRequest 
ethernetGermRequest 
f1oppyGermRequest 


DiskGermVariables <> 
EthernetGermVariables <> 
FloppyGermVariables <> 


- Virtual Memory Initialization: 

- Assume the following upon entry into this procedure: 


Upon exiting this procedure the following will be true: 


GermInit.asm 
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PROC 


InitializeGermParamaters: 

ASSUME 
IN 
AND 
CMP 
JE 

InitialIzeDaybreakGermParamaters: 

MOV 
MOV 
MOV 
XCHG 
MOV 

InitialIzeCommonGermParamaters: 

MOV 
MOV 
MOV 


DS:OpieIOR 
AX, machinelDPort 
AX, machine'IDMask 
AX, Daisy 

InitialIzeCommonGermParamaters 


ES, mesaPageMapSegment 

DI, mesaPageMapOffset 

AX, ES:[DI]+2*loaderV1rtual Page 

AX, £S:[DI]+2*gftVirtualPage 

ES:[DI]+2*loaderVirtual Page, AX 


AX, lOPELocalRAM 
ES, AX 

SI, ES: device 
%Mult1p1yByTwo (SI) 

MOV DX, germRequestVirtualPage 

XOR CX, CX 

MOV CH, mesaLogicalPageOpieAddress 

%EstablishIOPAccess(generalMapRegister,CX 


;the following MDS-relief stuff 
; Is for Daybreak only. 


;The germ's GFT is originally loaded 
;into the virtual page before the germ. 
;We must exchange its real page entry 
;with that of the GFT location 
jbefore Mesa starts running. 

;We want to find out what device 
;we ar8 booting from and hence we 
;need to look at boot variables 
;to know what device we booted from 
;but first let us establish access 

to the germ request section before 
-DX) ; initializing its variables. 


GermlnitFinished: 


MOV 

CALL 

RET 


DX, DI 

WORO PTR CS: germRequestlnit[SI] 


ENDP 


unknownInitRequest: 

RET 

DisklnitRequest: 

MOV 


MOV 


JMP 


CX, ((SIZE DiskGermVariables)/4) 
request, OFFSET diskGermRequest 
GermlnitRequest 


EthernetInitRequest: 


MOV 

PUSH 

MOV 

MOV 

MOV 

MOV 

MOV 

MOV 

MOV 

OR 

POP 


AX, 

ES 

ES, 

AX, 

CS: 

AX, 

CS: 

AX, 

CS: 

CS: 

ES 


lOPELocalRAM 

AX 

ES: baseEthernetFi1elD 

etherne tGermRequest.bootFi1eNumberHigh+2, AX 
ES: baseEthernetFileID+2 

ethernetGermRequest.bootFileNumberM1ddle+2, AX 
ES: baseEthernetFileID+4 

ethernetGermRequest.bootFileNumberLow+2, AX 
ethernetGermRequest.bootFi1eNumberLow+2, %ByteSwap 


(ethernetBootFileMask) 


MOV CX, ((SIZE EthernetGermVariables)/4) 

MOV request, OFFSET ethernetGermRequest 

JMP GermlnitRequest 


FIoppylnitRequest: 


MOV 

PUSH 

MOV 

MOV 

MOV 

MOV 

MOV 

POP 


AX. lOPELocalRAM 
ES 

ES, AX 

AX. ES: f1oppyBootFi1eAddress 

CS: floppyGermRequest bootFileCylinder+2, AX 

AX, ES: floppyBootFileAddress+2 

CS: floppyGermRequest.bootFileHeadAndSector+2, AX 
ES 


MOV CX, ((SIZE FloppyGermVariables)/4) 
MOV request, OFFSET floppyGermRequest 
JMP GermlnitRequest 


GermlnitRequest: 


MOV DI, DX 

OR 01, CS: [request][location] 

MOV AX, CS: [request][value] 

MOV ES: [01] ‘ AX 

ADD request, 4 

LOOP GermlnitRequest 


;Whenever these values change, we 
;$hould reassemble this module to 
;reflect the changes in MDS 0 which 
;is where the Germ variables are. 

:Look at the *GermVar iables to see 
:how this data structure is laid out 


RET 


IOPEInRAM ENDS 


**+*+********* 


END 


Germln i t.asm 
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;Copyright (C) 1984, 1985 by Xerox Corporation. All rights reserved. 


stored as [Iris3<WMicro>Dove>RAMDskBt.asm 
created on 30-Nov-84 13:44:00 

last edited by: 


J PM 

ll-May-87 10:26:33 

J PM 

8-May-87 12:45:13 

StuffNewDlskParms proc. 


J PM 

7-May-87 10:00:49 

JPM 

8-Jan-87 12:49:28 

JPM 

20-Sep-85 10:39:40 

kek 

4-Sep-85 16:03:18 

JPM 

4-Sep-85 8:16:12 

JPM 

3-Aug-85 10:38:34 

JPM 

22-Jul-85 12:37:34 

JPM 

15-Jul-85 8:53:30 

JPM 

12-Jul-85 12:03:29 

JMM 

9-Jul-85 17:22:59 

JMM 

26-Jun-85 21:12:43 

JMM 

26-Jun-85 16:40:07 

JPM 

17-Jun-85 12: 19:59 

NAME 

RAMDskBt 

$NOLIST 


SINCLUDE 

(HardDefs.asra) 

t> INCLUDE 

(lOPDef s.asm) 

$INCLUDE 

(RAMBDefs.asm) 

$ INCLUOE 

(ROMEEP.asm) 

$INCLUDE 

(DsklQFce.def) 

SINCLUDE 

(DskBDefs.asm) 

■filNCLUDE 

(IOPMacro.asm) 

$LIST 


EXTRN 

BootStrapHandlerlO: ABS 

EXTRN 

DiskHandlerlD: ABS 

EXTRN 

DlsplayMPCode: NEAR 

%*DEFINE 

(Zero (start.end)) 


Add new MP codes for self-describing disk errors. 

Add delay for non-self-descrlbing disks (so MP code is visible); reduce code size in 

Add code for self-describing disks (read sector and change disk parms). 

Fix bug In DiskReadError (needed to set BX before jump to InitlOCB). 

Do boot buffer allocation. 

more mp codes, use public mp code rtn. 

Standardize MP codes, remove display change 
Change EEPDefs.asm to ROMEEP.asm 
Opie redesign conversion 

;Set diskFCB.diskStartHandlerForlOP to FALSE after finished booting. 

;Fixed bug in CalcNextAddr (inadequate check for double-zero). 

;Upgraded to new Disk handler. 

;Restored old EOF protocol and IOPMacro. 

;Moved include files here. Also IOPLRAM. 


LOCAL Lb 10 
( MOV 
b10: MOV 
INC 
CMP 
JL 
) 


SI, OFFSET %start 
BYTE PTR [SI]. 0 
SI 

SI, OFFSET %end 
%Lbl 0 


IOPELocalRAM SEGMENT AT 0 


EXTRN 

EXTRN 

EXTRN 

EXTRN 

EXTRN 


opieReentry: DWORD 
bootType: BYTE 
bootRetryCount: WORD 
startOfBootBufferSpace: WORD 
HandlerlnitProcTable: DWORD 


IOPELocalRAM ENDS 


BootStrapIOR 

SEGMENT COMMON 

ASSUME DS:BootStrapIOR 

EXTRN 

EXTRN 

EXTRN 

EXTRN 

EXTRN 

EXTRN 

EXTRN 

EXTRN 

dsklOCB 

diskWorkspace 

bootBufferEmpty: Condition 
bootBufferFull: Condition 
startOfBootBufferPool: WORD 
bootDevicelORSpace: DiskBootArea 
bootStrapTask: TaskContextBlock 
bootTask: TaskContextBlock 
getBootFile: Condition 
finishedLoaderFileFetch: Condition 

EQU bootDevicelORSpace.diskBootlOCB 

EQU bootDevicelORSpace 

BootStrapIOR 

ENOS 

DisklOR 

SEGMENT COMMON 

EXTRN 

diskFCB: OiskFCBRecord 

DisklOR 

ENDS 

MaintPane1IOR 

SEGMENT COMMON 

EXTRN 

maintPanelCode: WORD 


RAMOskBt.asm 
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EXTRN 


maintPanelChanged: Condition 
ENDS 


MaintPanelIOR 


BootStrapSTK 


SEGMENT COMMON 


EXTRN 


BootStack: WORD 


BootStrapSTK ENDS 


lOPEInRam SEGMENT PUBLIC 

ASSUME CS:IOPEInRam 


PUBLIC 


RAMDiskEntryPoint 


EXTRN BootTasklnit: NEAR 

EXTRN EndOflnitial: NEAR 


Order of actions: 

(1) Load rest of DIsklnltialDove.db (from cyl. 
or as directed by label fields) 

(2) Read disk shape page (from cyl, 0, head 0, 

(3) Read root page (from cyl. 0, head 0, secto 

(4) Invoke UI to select boot sequence 

(5) Load each file In turn, one buffer (= one 

(6) Idle this boot task forever 


0, head 1, sectors 

sector 15) 
r 0) 

sector) at a time 


1-n, 


-- Disk RAM Boot: 

- This module reads in the rest of DiskinitialDove.db into 

- IOP local RAM. It then proceeds to get the emulator file 

- MesaDove.db and the germ Dove.germ in conjunction with the 

- generic boot code. 


Upon exiting this module the following will be true: 


bootStrapTask will be waiting forever on the 
condition variable "idledBootTasks". 


ORG 0 

RAMDiskEntryPoint: 

; step 1 

: set up ClientCondition in disk FCB 

%EstablIshHandlerAccess (DiskHandlerlD) 

ASSUME ES:DisklOR 

MOV diskFCB.rdO.disklOPClientCondition.handlerlD, LOW BootStrapHandlerlD 

MOV diskFCB.rdO.disklOPClientCondition.conditionPtr. OFFSET diskWorkspace.disklOCBDone+nonNi1Ptr 
MOV diskFCB.rdO.disklOPClientCondition.clientMask, 0 
; set up disk IOCB (disk characteristics and data address) 

MOV BX, OFFSET dsklOCB,diskOperationB1ock 

MOV AL, diskFCB.rdO.diskSectorsPerTrack 

MOV [BX].diskSecPerTrack. AL 

MOV AL, diskFCB.rdO.diskHeadsPerCylinder 

MOV [BX].diskHdsPerCy1, AL 

MOV AX, diskFCB.rdO.diskCylindersPerDrive 

MOV [BX].cylPerDrive, AX 

MOV AX, diskFCB.rdO.diskReducedWriteCurrentCylinder 

MOV [BX].diskReducedWriteCyl, AX 

MOV AX, diskFCB,rdO.diskPreCompensationCylinder 

MOV [BX].diskPreCompCyl, AX 


: set up ES for access to boot 
MOV 
MOV 
ASSUME 
MOV 
MOV 
MOV 

; change startOfBootBufferSpace 
ADD 

; call DiskRead 
GetRestOfInitial : ADD 

CALL 
JNC 
JMP 


variables 
AX, IOPELocalRAM 
ES, AX 

ES:IOPELocalRAM 

dsklOCB.dlskDataPtrHigh, (IOPLogicalOpieAddress SHL 
BX, startOfBootBufferSpace 
dsklOCB,diskDataPtrLow, BX 
to point past end of code 
StartOfBootBufferSpace, OFFSET EndOflnitial 

dsklOCB.diskDataPtrLow, sectorSize 
DiskRead 

GetRestOfInitial 
RamDiskCont 


8 ) 


; put DiskRead here, so will be 

: proc to read from disk 

DiskRead PROC 

ASSUME 


in first sectorSize bytes 


NEAR 

ES:IOPELoca1 RAM 


RAMDsk8t.asm 
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: calculate next 

disk address from DOB (prev. address and label) 

CalcNextAddr: 

MOV 

BX, OFFSET dskI0C8.diskOperationBlock 


MOV 

AX, WORD PTR [BX].diskLabel.diskDontCare 


MOV 

CX, WORD PTR [BX].diskLabel,diskDontCare+2 

: if both words are 0, increment old address 


MOV 

DX, AX 


OR 

DX, CX 


JZ 

IncrPrevAddress 

; if both words are FFFF, end-of file has been reached 

; otherwise, the 

words contain 

the next disk address 


CMP 

AX, OFFFFH 


JNE 

UseAddressInAXCX 


CMP 

CX, OFFFFH 


JNE 

UseAddressInAXCX 

; end-of-file: sot carry and return 


STC 



RET 


; secondary entry 

point for new 

file -- disk address in AX:CX 

DiskReadNewFi1e: 

MOV 

BX, OFFSET dsklOCB,diskOperationBlock 

; AX:CX contains 

next sector address: store into DOB 

UseAddressInAXCX; 

MOV 

WORD PTR [BX].diskHeader, AX 


MOV 

WORD PTR [BX] .diskHeader+-2, CX 


JMP 

SHORT InitlOCB 

: label contains 

nil: increment 

previous address 

IncrPrevAddress: 

MOV 

CX, WORD PTR [BX].diskHeader+2 


INC 

CL 


CMP 

CL, [BX].diskSecPerTrack 


JL 

StoreNewAddress 


XOR 

CL, CL 


INC 

CH 


CMP 

CH, [BX].diskHdsPerCy1 


JL 

StoreNewAddress 


XOR 

CH, CH 


INC 

[BX].diskHeader,diskCylinder 

StoreNewAddress: 

MOV 

WORD PTR [BX].diskHeader+2. CX 

: initialize other IOCB fields 


InitlOCB: 

MOV 

AL, read 


MOV 

[BX].diskOperation, ReadDiskLabelAndData 

InitIOCBCont: 

%Zero 

(dsklOCB.diskDatalnfoRec, dsklOCB.diskOperationBlock) 


MOV dsklOCB.diskDataXferDirection, AL 

MOV dsklOCB.diskPageCount, 1 

MOV [BX].dlskMinusSectorCount, -1 

MOV [BX].diskHeaderError, 0 

MOV [BX].diskLabelError, 0 

MOV [BX].diskDataError, 0 

MOV [BX].diskLastError, 0 

; put IOCB onto disk queue 
EnqueuelOCB: PUSH ES 

%EstablishHandlerAccess (DiskHandlerlD) 

ASSUME ES:DiskIOR 

MOV CH, IOPIORegionOpieAddress 

MOV CL, LOW BootStrapHandlerlO 

MOV diskFCB.rdO.disklOPNextLow, OFFSET dsklOCB 

MOV d1skFCB.rdO,d1sklOPNextHigh, CX 

MOV diskFCB.diskStartHandlerForlOP. OFFFFH ;jmm: Change to TRUE later, 

POP ES 

ASSUME ES:IOPELocalRAM 

; wake up handler and wait for return notify 

%Not1fyHandlerCond1tion (DiskHandlerlD,OFFSET diskFCB .diskConditionWork) 
%WaitForCondition (OFFSET diskWorkspace-dlsklOCBDone,noTimeout) 

; check for good completion 

TEST dsklOCB.dlskError, OFFH 

JNZ DiskReadError 

DiskReadDone: CLC 

RET 

: determine error type (eventually -- just retry for now): 

: (a) CRC error -- retry 

; (b) wrong cylinder error -- recalibrate, retry 

: (c) other errors -- ? 

DiskReadError: DEC bootRetryCount 

JZ TooManyRetries 

MOV BX, OFFSET dsklOCB.diskOperationBlock 

JMP InitlOCB 

;1f too many retries, hang with MP code 
TooManyRetries: MOV AX, mplnitialError 

CallDispMP: CALL DisplayMPCode 

Done: %Jam (BootStrapHandlerlD,OFFSET bootStrapTask) 

%Wa1tForSystem ; never returns! 

DiskRead ENDP 

idisplay mp code for executing initial microcode 
ASSUME ES:IOPELocalRAM 

RamDiskCont: MOV AX, mpRunlnitial 

CALL DisplayMPCode 

: step 2 

MOV BX, OFFSET dsklOCB.diskOperationBlock 

MOV AX, diskShapeCylinder 

MOV CX, diskShapeHeadAndSector 

MOV SI. startOfBootBufferSpace 

ADD SI, bootDataBegins + sectorS1ze-l 

ANO SI, NOT (sectorSize-I) 

MOV dsklOCB,diskDataPtrLow, SI 

PUSH SI 
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SUB SI, bootDataBegins 

MOV startOfBootBufferPool , SI 

MOV ES:[$I], nextBootBuffer, SI 

MOV ES:[SI].bootDataStart, Null 
MOV ES:[SI].bootDataEnd, Null 

MOV bootRetryCount, 10 

MOV WORD PTR TooManyRetr1es+1, mpSDDReadError 

ReadDiskShape: CALL DiskReadNewFile 

POP SI 

PUSH SI 

; verify seal, version, and checksum 

CMP £S:[SI].DSseal, diskShapeSeal 

JE DiskShapeSealOK 

DiskShapeSealError: MOV AX, mpSDDSealError 

CALL DIsplayMPCode 

; seal mismatch may be due to old formatting 

; look at checksum words; if they don't match, continue booting with EEPROM disk parms 
MOV AX, ES:[SI].DSchecksum 

NOT AX 

CMP AX, £S:[SI].OSinvertedChecksum 

JE Done 

; pause before booting so code Is visible 

%WaitForTime (2000) ; two seconds 

JMP SHORT RamDiskStep3 

; other error conditions 

D IskShapeCksmError: MOV AX, mpSDDCksmError 

JMP Cal 1DispMP 

DIskShapeVrsnError; MOV AX, mpSDDVrsnError 

JMP CalIDispMP 

DiskShapeSealOK: MOV AX, ES:[SI].DSchecksum 

NOT AX 

CMP AX, ES:[SI].OSinvertedChecksum 

JNE DiskShapeCksmError 

CALL CalcChecksum 

CMP AX, ES:[SI].DSchecksum 

JNE OiskShapeCksmError 

CMP ES:[SI].DSversion, diskShapeVersion 

JNE DiskShapeVrsnError 

: disk shape is OK -- use parms for booting 

CALL StuffNewDi skParnis 

; step 3 

RamDiskStep3: MOV BX, OFFSET dsklOCB.diskOperationBlock 

MOV AX, rootPageCylinder 

MOV CX, rootPageHeadAndSector 

MOV WORD PTR TooManyRetries+1, mpMesaDoveError 

ReadRootPage: CALL DiskReadNewFile 

POP SI 

MOV AX, SI 

ADD AX, sectorSize ;add sector size 

MOV startOfBootBufferSpace, AX ; and store for booting 

ADD SI, rootPageHeaderSize : set up for 1st file ID 

; step 4 (for now, skip UI and set up for diagnostic or Mesa boot) 

CMP bootType, normal 

JE SetUpMesaBoot 

; diagnostic boot: load one file from root file 0 
SetllpDiagnosticBoot: MOV CH. ES: [SI] .DFIDcyl inderHigh 

MOV CL, ES:[SI].DFIDcylinderLow 

MOV DH, ES:[SI].DFIDhead 

MOV DL, ES:[SI],DFIDsector 

MOV diskWorkspace.filel.Cyl, CX 

MOV diskWorkspace.filel.HdSct, DX 

MOV diskWorkspace.f11eCount. 1 

JMP SHORT LoadFiles 

: Mesa boot: load two files from root files l (uCode) and 2 (germ) 

SetUpMesaBoot: ADD SI, SIZE(DiskRootFilelO) 

MOV CH. ES:[SI].DFIDcylinderHigh 

MOV CL, ES:[SI].DFIDcylinderLow 

MOV DH. ES:[SI].DFIDhead 

MOV DL, ES:[SI].DFIDsector 

MOV diskWorkspace.filel.Cyl, CX 

MOV diskWorkspace.filel.HdSct, DX 

ADD SI, SIZE(DiskRootFilelD) 

MOV CH, ES:[SI].DFIDcylinderHigh 

MOV CL, ES:[SI].DFIDcylinderLow 

MOV DH, ES:[SI].DFIDhead 

MOV DL, ES:[SI].DFIDsector 

MOV diskWorkspace.file2.Cyl, CX 

MOV diskWorkspace.f11e2.HdSct, DX 

MOV diskWorkspace.f1leCount, 2 

; step 5 

LoadFiles: ^Restart (BootStrapHandlerlD.OFFSET bootTask.BootTasklnit.OFFSET BootStack) 

MOV SI, OFFSET diskWorkspace.fi1e1 

; load one complete file 
LoadLoop: PUSH SI 

%WaitForCondition (OFFSET getBootFile,noTimeout) 

POP SI 

MOV AX, [SI].Cy1 

MOV CX. [SI].HdSct 

MOV DI, startOfBootBufferPool 

MOV bootRetryCount, 10 

PUSH SI 

PUSH DI 
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; read first sector of new file Into (page-aligned) buffer 
CALL DiskReadNewFile 

; notify boot task that a buffer Is ready 
NotifyBufferFull: POP DI 

MOV ES:[01],bootDataStart, bootDataBeglns 

MOV ES:[DI].bootDataEnd, bootDataBegins+sectorSize-1 

%NotifyCondition (OFFSET bootBufferFu11) 

; wait till buffer becomes available 
WaitForBuffer: PUSH DI 

%WaitForCondition (OFFSET bootBufferEmpty,noTtmeout) 

POP 01 

TEST getBootFile.TCBLInkPtr, preNotifyFlag 
JNZ DoneWithFile 

MOV BX, ES:[DI].bootDataEnd 

CMP BX, ES:[DI].bootDataStart 

JNE WaitForBuffer 

MOV bootRetryCount, 10 

; read next sector into local buffer 
PUSH DI 

CALL DIskRead 

JNC NotifyBufferFull 

POP DI 

: done with file - decrement file count 
DoneWithFile: POP SI 

DEC diskWorkspace.flleCount 

JZ DoneWithAllFiles 

ADD SI, SIZE (FileSpec) 

JMP LoadLoop 

DoneWithAllFiles: %EstablishHandlerAccess (DiskHandlerlD) 

ASSUME ES:01skI0R 

MOV diskFCB.diskStartHandlerForlOP, FALSE 

"ZNotifyCondition (OFFSET finishedLoaderFileFetch) 

; step 6 

: idle till task is subsumed 

JMP Done 

: utility procs 

ASSUME ES:NOTHING 

CalcChecksum PROC NEAR 

^Arguments: £S:SI offset of word-aligned buffer 

;Returns: AX: word checksum 

;U$es (without saving): CX, DX 

unChecksummed EQU OFFFFH 

checksumExtent EQU 254 ; size of page, in words, minus checksums 

;set up for loop 

PUSH SI 

MOV CX, checksumExtent 

XOR AX, AX 

SumNextWord: MOV OX, ES:[SI] 

XCHG DH, DL ibyteswap word 

;The following sequence is the checksum algorithm 
ADD AX, DX 

ADC AX. 0 

ROL AX, 1 

:advance to next word 

INC SI 

INC SI 

LOOP SumNextWord 

:normalize result 

CMP 
JNE 
XOR 

ChecksumExit: XCHG 

POP 
RET 

CalcChecksum ENDP 


StuffNewOiskParms PROC NEAR 

;Arguments: ES:SI offset of disk shape page descriptor 

;Uses (without saving): AX, BX 

; note that all word values in disk shape must be byte-swapped 
PUSH ES 

;fix IOCB first, saving values In stack 

MOV BX, OFFSET dsklOCB.diskOperatlonBlock 

MOV AL, ES:[SI].DSsectorsPerTrack 

MOV [BX],diskSecPerTrack, AL 

MOV AH, ES:[SI].DSheadsPerCylinder 

MOV [BX].diskHdsPerCyl, AH 

PUSH AX 

MOV AX, ES:[SI].DScylInderCount 

XCHG AH, AL ;byte-swap 

MOV [BX],cylPerDrive, AX 

PUSH AX 

MOV AX, ES:[SI].DSreducedWriteCyl 

XCHG AH, AL ;byte~swap 

MOV [BX].diskReducedWriteCyl, AX 

PUSH AX 

MOV AX, ES:[SI].DSpreCompCy1 

XCHG AH, AL ;byte-$wap 


AX, unChecksummed 
ChecksumExit 
AX, AX 

AH, AL ;byteswap checksum 

SI 
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: now change values i 


StuffMewDiskParms. 

lOPEInRam 


RAMDskBt.asm 1 


MOV [BX].d1skPreCompCy1, AX 

PUSH AX 

n disk FCB 

%Establ1shHandlerAccess (OlskHandlerlD) 

ASSUME ES:DisklOR 

POP diskFCB.rdO.diskPreCompensationCylinder 

POP diskFCB.rdO.diskReducedWriteCurrentCylinder 
POP diskFCB.rdO.diskCylIndersPerDrive 

POP AX 

MOV diskFCB.rdO.diskHeadsPerCylinder. AH 

MOV diskFCB.rdO.diskSectorsPerTrack, AL 

POP ES 

ASSUME ES:NOTHING 

RET 

ENDP 


ENDS 


END 
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-- stored as [Idun]<WMicro>Dove>RAMEEP.asm 
-- created on 14-Feb-84 11:13:22 

-- This file is intended to contain RAM-resident portion of EEProm constants. 

-- last edited by: 

KEK 20-Mar-86 10:21:11 ;add DlagAutoRun/ROClandingZone/WriteCount 

JPM 2-Aug-85 17:22:24 :Removed eePromLowMem and eePromHighMem (now in ROMEEP.asm), 

KEK 31-Jul-85 16:31:19 :created RAMEEP.asm from orig EEPDefs.asm 

JPM 14-Nov-84 14:52:53 :Updated for new layout. 

JPM 12-0ct-84 16:11:44 :Updated for new layout. 

VXS 16-Aug-84 11:04:01 :made EEPromSegment COMMON. 

VXS 8-Aug-84 15:43:40 :Made tempEEPromlmage so we 

;know where this thing is. (fixes bug where if wordsInEEProm 
;wasn't on even 4 word boundary, would be overlap) 

JPM L9-Jul-84 11:04:57 :Added eePromLockMode. 

VXS ll-Jul-84 16:28:56 iCreation, See IOPDefs.asm for earlier history. 


;Definitions for RAM-used offsets within EEProm: 

;(for the other eeprom defs, see latest ROMEEP.asm and BadPage.asm) 

eeProniMemSi ze EQU RAMSegment+byteEEPromOffset+25 

: [0..3] = encoded VM size (in increments of 64 map pages) 

: 0 => none 

; 1 => 64 VM map pages 

: 2 => 128 VM map pages 

: 3 => 256 VM map pages 

: [4..7] = encoded control store sizes (in increments of 4K pages) 

: 0 => none 

; 1 => 4K control store 

; 2 => 8K control store 

eePromHardwareBuild EQU RAMSegment+byte£EPromOffset+26 

; 0 => ?none 

: 1 => BO/Bl 

; 2 => B2 

; 3-255 => spare incremental encodings 

eePromMIsc EQU RAMSegment+byteEEPromOffset+27 

: [0..0] = Default boot type bit2 (with or without diagnostics) 

; [1..1] = Default diagnostic boot type bit (short or long) 

; [2.,7] - spare 

eePromRS232DC£type EQU RAMSegment+byteEEPromOffset+28 

eePromRS232DCEattr EQU RAMSegment+byteEEPromOffset+29 

eePromRS232DTEtype EQU RAMSegment+byteEEPromOffset+30 

eePromRS232DTEattr EQU RAMSegment+byteEEPromOffset+31 

eePromPCEMemSize EQU RAMSegment+wordEEPromOffset+32 

eePromPCEConfig EQU RAMSegment+wordEEPromOffset+34 

eePromOption1 EQU RAMSegment+wordEEPromOffset+36 

eePromOption2 EQU RAMSegment+wordEEPromOffset+38 

eePromOption3 EQU RAMSegment+wordEEPromOffset+40 

;this is actually defined in ROMEEP.asm. 

leePromFloppy EQU ROMSegment+wordEEPromOffset+42 

;eePromSpare2 EQU RAMSegment+byteEEPromOffset+44 

;eePromSpare3 EQU RAMSegment+byteEEPromOffset+45 

:eePromSpare4 EQU RAMSegment+byteEEPromOffset+46 

;eePromSpare6 EQU RAMSegment+byteEEPromOffset+47 

;eePromSpare6 EQU RAMSegment+byteEEPromOffset+48 

:eePromSpare7 EQU RAMSegment+byteEEPromOffset+49 

eePromOiagAutoRun EQU RAMSegment+wordEEPromOffset+44 

eePromRDClandingZone EQU RAMSegment+wordEEPromOffset+46 

eePromWriteCount EQU RAMSegment+wordEEPromOffset+48 


eePromSpareS 

EQU 

eePromSpare9 

EQU 

eePromSparelO 

EQU 

eePromSparell 

EQU 

eePromSparel2 

EQU 

eePromSparel3 

EQU 

eePromSparel4 

EQU 

eePromSparel5 

EQU 

eePromSparel6 

EQU 

eePromSparel7 

EQU 

eePromSparel8 

EQU 

eePromSparel9 

EQU 

eePromSpare20 

EQU 

eeProm.Spare21 

EQU 

eePromSpare22 

EQU 

eePromSpare23 

EQU 

eePromSpare24 

EQU 

eePromSpare25 

EQU 


RAMSegment+byteEEPromOffset+50 
RAMSegment+byteEEPromOff set+51 
RAMSegment+byteEEPromOffset+52 
RAMSegment+byteEEPromOffset+53 
RAMSegment+byteEEPromOff set+54 
RAMSegment+byteEEPromOff set+55 
RAMSegment+byteEEPromOff set+56 
RAMSegment+byteEEPromOff set+57 
RAMSegment+byteEEPromOff set+58 
RAMSegment+byteEEPromOff set+59 
RAMSegment+byteEEPromOffset+60 
RAMSegment+byteEEPromOffset+61 
RAMSegment+byteEEPromOff set+62 
RAMSegment+byteEEPromOffset+63 
RAMSegment+byteEEPromOffset+64 
RAMSegment+byteEEPromOffset+65 
RAMSegment+byteEEPromOffset+66 
RAMSegment+byteEEPromOffset+67 


RAMEEP.asm 
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iCopyr1ght (C) 1984, 1985 by Xerox Corporation. All rights reserved. 


IQRegion locations for the boot handler, 
stored as [Iris]<WMicro>Dove>ROMOefs.asm 


;1ast edited by: 


: -- 

RDH 


17-Sep-85 

12 

08 

50 

; -- 

RDH 


14-Sep-85 

10 

08 

50 

: -- 

RDH 


14-Sep-85 

9 

04 

37 

: -- 

RDH 


13-Sep-85 

19 

21 

18 

maintPanelBkGrdHe 

ght. 




; -- 

RDH 


13-Sep-85 

17 

12 

16 


RDH 


12-Sep-85 

14 

37 

06 

segment 

was never 

used. 





: -- 

RDH 


12-Sep-85 

14 

14 

25 

; -- 

RDH 


12-Sep -85 

12 

02 

22 

; — 

RDH 


12-Sep-85 

11 

34 

41 

: -- 

RDH 


il-Sep -85 

16 

32 

29 

. 

kek 


5-Sep-85 

19 

40 

32 

; -- 

RDH 


17-Aug -85 

17 

39 

22 

; -- 

RDH 


14-Aug-85 

11 

49 

32 

. 

J PM 


t5~Jul-85 

17 

04 

07 

: -- 

JPM 


ll-Jul -85 

10 

03 

32 

CallHanc 

lerlnitProc. 





. 

JMM 


19 -Jun^85 

15 

19 

54 

: 

JPM 


21-May -85 

12 

54 

14 

: -- 

JMM 


4-Apr-85 

15 

01 

14 

. 

JMM 


6-Feb~85 

9 

21 

27 

: -- 

JMM 


28-Jan-85 

18 

25 

43 

: -- 

JMM 


25-Nov-84 

16 

04 

38 

; --- 

JPM 


3-Nov-84 

11 

21 

53 


BKI/JMM 


24-0ct-84 

16 

14 

15 

; NAME 



ROMBDefs 






;Change maintPanelBkGrdRightPad and maintPanelBkGrdHeight for prettier mp codes. 
;Change tlmeoutlnterval to seconds Instead of millisecs. 

;Add oneSecond. 

;Add constants for cursor visibility: malntPanelBkGrdRightPad, 

;Changed timeout Interval to 35000 (thirty five seconds). 

.Made icondatastructure smaller since there is no more mouse tracking and ICON 

;Add hideCursorOisplayOn. 

;Add timeOutDisab and timeOutEnab. 

;Add backToUI and bootSystem, 

;Add timeoutlnterval. 

;mp code definitions 
;Add niceCursorOisplayOn. 

;Fold in UI stuff. 

;Added constants from ROMEthBt.asm, 

;Took fields out of floppy context (will use floppy IOCB def), added 

;Added macro. 

;Diagno$tic boot changes. 

:Add boot error constants section. 

;Add macro section. 

:Added floppy changes. 

;Remove EthlOFce from INCLUDES, add Floppy IOCB skeletal structure. 

;First release. 


;Constants for STRUC definitions. 


BootJumpTable 

STRUC 




StartRAMOpie 

DW 

7 

;An IOP Start block will resu 

it in an IOP 

startRAMOpieCS 

DW 

? 

:address being saved here for 

later entry 

iopf: ntry 

DW 

? 

iOpEintryCS 

DW 

? 



processBootBlock 

DW 

7 



BootJumpTable 

ENDS 





; Boot!imeVariables 

STRUC 




:device 

DW 

7 


;1-Disk, 2-Ethernet, 3-Floppy, 4-RS232C. 

:mode 

DW 

7 


;0-Normal, 1-Fast boot 

:showUserlnterface 

DW 

7 


;0-yes, #0-no. 

ibootRetryCount 

DW 

7 


: initially 0, incremented per failure 

:reincarnationFlag 

DW 

7 


;For task reinitialization - 0 => tasks 
;to use local RAM otherwise main memory. 

;emulatorID 

DW 

3 

DUP( ? 

;Initially 0, updated by boot executive 

;1oaderlD 

DW 

3 

DUP( ? 

initially o, updated by boot executive 

: d iagnosticsType 


OW 

? initialized at boot-time. 0 => 


diagnostics - user has set EEPROM to 
indicate desire for a diagnostics boot. 
#0=> long diagnostics boot - user has 
manually requested diagnostics at boot 
time! 


;BootTimeVariables 

ENDS 


:Dev ice types: 



disk 

EQU 

1 

floppy 

EQU 

2 

ethernot 

EQU 

3 

experimental 

EQU 

4 

rs232C 

EQU 

4 


Boot types: 


norma 1 

EQU 

0 

diagnostic 

EQU 

l 
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Boot ICON STRUC's and constants: 


ICONDataStructure 

STRUC 



ICOMleftlmagePtr 

DW 

7 

Pointer to image of ICON symbols 0 => no symbol. 

ICONRightlmagePtr 

DW 

? 

Pointer to image of ICON symbols 0 = > no symbol. 

ICOMOffset 

OW 

? 

This is this ICONS offset in display memory. 

; ICONSegment 

DW 

? 

This is this ICON'S segment in display memory. 

; leftBoundary 

DW 

? 

Left icon edge from the left of the screen In bits. 

;rlghtBoundary 

DW 

7 

Right icon edge from the left of the screen in bits 

bootingProcedure 

DW 

? 

Offset to procedure that does selected boot. 

invertedICON 

DB 

7 

0 => not inverted else inverted, 

bool.Device 

DB 

? 

0 => no device present here. 

typeOfBoot 

DB 

7 

0 => normal boot, otherwise diag. boot. 

previousICON 

DW 

? 

0 => this is the first icon. 

nextICON 

DW 

7 

0 => this is the last icon. 

ICONDataStructure 

ENDS 




cursorPosition 

STRUC 




X 

DW 

7 



y 

DW 

7 



cursorPosition 

ENDS 




totalLengthOfICON 

EQU 

672 

;In bits. 


lengthOfICON 

EQU 

64 



widthOfICON 

EQU 

24 

;Lines. 


ICONVerticalDiplacement 

EQU 

10 

;Trial and 

error for visual appeal. 

ICONHorizontalDIplacement EQU 

5+lengthOfICON 

;Trial and 

error for visual appeal. 

displayON 

EQU 

11101010B 

:Bit 3 set 

enables the display. 

niceCursorOisplayOn 

EQU 

10001010B 

;High nibble makes cursor AND with bitmap. Bit 3 set enables the display 

h ideCursorDisplayOn 

EQU 

OCAH 



niceMPDisplayOn 

EQU 

04AH 




Misc. constants: 


numberOfSoftkeys 

EQU 

10 


crossOver64KbBank 

EQU 

01000H 


distanceFrom8ottom 

EQU 

30 

;Number of scan lines from bottom of icons to bottom of display. 

ICONBottomEdge 

EQU 

10 

;???jmm:85-03-27 

ICONInnerDepth 

EQU 

24 

;scan lines in icon button 

ICONByteLength 

EQU 

8 

;length and width are the same thing here. 

ICONBitWidth 

EQU 

64 

;Depth is up and down. 

vertlconOffsetlnButton 

EQU 

4 

;scan lines 

leftlconOff setlnButton 

EQU 

1 

;bytes 

rightlconOff setlnButton 

EQU 

5 

:bytes 

threeSeconds 

EQU 

3000 

;Number of seconds to wait before starting default booting This is 10 seconds plus the 25 where 

timeoutlnterval 

EQU 

35 

25 is the approx time it 

takes 

for the 

daybreak display to be clearly visible from a cold start. 

maintPanelBkGrdRightPad 

EQU 

OFOH 

;High 4 bits of byte quantity are set. 

maintPanelBkGrdHelght 

EQU 

20 

;mpcodeCursorXPos + Cursor height +■ mpcodeCursorXPos. 

mpcodeCursorXPos 

EQU 

2 

:Leave space between mpcode and border. 

mpcodeCursorYPos 

EQU 

2 

:Leave space between mpcode and border. 

backToUI 

EQU 

1 

;For communication with diagnostics in finishMode. 

bootSystem 

EQU 

0 

;For communication with diagnostics 

tlmeOutEnab 

EQU 

1 

;Allow timeouts in boot device selection. 

timeOutDisab 

EQU 

0 

;Wait indefinitely for user. 

inverted 

EQU 

-l 


notlnverted 

EQU 

0 


numberOfICONs 

EQU 

4 


wordBitSize 

EQU 

16 


byteLength 

EQU 

8 


wordLength 

EQU 

16 


fatDaisy 

EQU 

0 


fatDayb reak 

EQU 

0 


doveDisplayBasePage 


EQU 

0 ; In decimal page numbers. 

f atDaybreakDisplayBasePage 

EQU 

0 ;In decimal page numbers. 

fatDaisyDisplayBasePage 


EQU 

0 

;slImDaybreakDisplayBasePage 

EQU 

768 

siimDaybreakDisplayBasePage 

EQU 

0 ; jmm:84-12-04:UntilGAPmoves. 

siimDaisyDisplayBasePage 


EQU 

512 

:fatDaybreakDIsplayMemSize 

EQU 

1024 ; In decimal page numbers. 

daisyDisplayMemSize 


EQU 

256 

fatDaybreakDisplayMemSize 

EQU 

256 

siimDaybreakDisplayMemSi 

ze 

EQU 

256 

byteWordAlignMask 

EQU 

OFEH 


wordWordAlignMask 

EQU 

OFFFEH 


dontCare 

EQU 

0 


setAtRunTime 

EQU 

0 


status 

EQU 

0 
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nul 'lOffset 


0 


pageSizelnBytes 


EQU 

EQU 0200H 


Disk ROM boot constants and STRUC's: 


DiskBootContext 

STRUC 



disklOCBOone 

DB 

(SIZE Condition) 

DUP (?) 

diskBootlOCB 

DB 

156 DUP (?) 

;SIZ£ DisklOCBRecord in DsklOFce.def 

DiskBootContext 

ENDS 




Ethernet ROM boot constants and STRUC*s: 


srcOffset 

EQU 

6 


typeFieldOffset 

EQU 

12 


checksumOffset 

EQU 

14 


lengthOff set 

EQU 

16 


srci-lostOffset 

EQU 

36 


bfnOffset 

EQU 

46 


seqMumberOffset 

EQU 

52 


bootDataOff set 

EQU 

54 


maximumBootBufferSize 

EQU bootDataOffset+pageSizelnBytes 

bfnSize 

EQU 

6 

ibytes 

encapsulation 

EQU 

checksumOffset 


tenSeconds 

EQU 

10000 

:(in milliseconds) 

oneSecond 

EQU 

1000 

;(in milliseconds) 

EtherBootContext 

STRUC 


etherlOCB 

DB 

40 DUP (?) 

;jpm 84-11-2 >= SIZE(ethernetlOCB) 

etherlOCBDone 

DB 

(SIZE Condition) DUP 

(?) 

noResponseTimer 

DW 

•? 


retryCount 

OW 

? 


romRetryEntry 

DD 

? 


initialBufPtr 

DW 

? 

:place to load next piece of EtherlnitialDove.db 


EtherBootContext ENDS 


Floppy ROM boot constants and STRUC*s: 


FloppyBootContext 

STRUC 


floppylOCBDone 

DB 

(SIZE Condition) DUP (? 

floppylOCB 

DB 

152 DUP (?) 

FloppyBootContext 

ENDS 



Convenience macros: 


%*Define (MultiplyByTwo (register)) 

(ROL “/.register, 1) 

%*Define (Dlvide8y2 (register)) 

(SHR “/.register, 1) 

%*Define (DivideByA (register)) 

(SHR “/.register, 2) 

“/.♦Define (ByteSwap (wordToSwap)) 

(%wordToSwap SHL 8 OR %wordToSwap SHR 8) 

“/.♦Define (CallHandlerlnitProc (handlerlD)) ( 

MOV DI, “/.handlerlD 

SHL DI, 2 

PUSH DS 

PUSH ES 

CALL DWORD PTR HandlerlnitProcTable[DI] 

POP ES 

POP DS 


;Booting error 

numbers: 


bootingError 

EQU 

-1 

noBufferSpace 

EQU 

0101H 

noLoadSpace 

EQU 

0202H 

unKnownBootBlock EQU 

0303H 
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noRAMStartAddress EQU 0404H 
diskROMBootError EQU 0405H 


Maintenance Panel Codes: 


mpStartBooting 

EQU 

OlOOD 

mpDeviceUnknown 

EQU 

0113D 

mpFetchlnitial 

EQU 

0149D 

mpRunlnitial 

EQU 

0150D 

mplnitialError 

EQU 

0151D 

mpFetchMesaOove 

EQU 

0199D 

mpRunMesaDove 

EQU 

0200D 

mpMesaOoveError 

EQU 

020 ID 

mpRunGerm 

EQU 

0501D 

mpfloppyCleaning 


EQU 


0077D 
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$MOD186 

SPAGELENGTH 

SPAGEWIDTH 


(72) 

(136) 


;Copyr1ght (C) 1984, 1985 by Xerox Corporation. All rights reserved. 

stored as [Iris]<WM1cro>Dove>ROMBoot.asm 
created on 19-Jul-84 13:20:18 


;-- 1ast edited by: 
JAC 
KEK 

baseEthernetFi lelD. 
CWM 

CWM 

;-- CWM 
CWM 
CWM 


CWM 

CWM 


15-Jan-87 10:46:00 
12-May-86 12:44:21 

30-Apr-86 22:37:17 

25-Apr-86 19:58:10 

25-Apr-86 12:17:25 

23-Apr-86 1:41:16 

22-Apr-86 23:29:29 

21-Apr-86 23:42:53 
20-Apr-86 22:03:52 


1912 BYTES 


;fix alt enet booting, fix short or long alag bug 

;change e'net address to 252000043008. (Daybreak is 25200004000B), Also, OR into 

;ReInstall diagnostic Icon 
; 1671 bytes/241 bytes saved 
;Cut out icon top/bottom calcs 
; 1633 bytes/279 bytes saved 
;Cut out diagnostic icon for Karey 
: 1649 bytes/263 bytes saved 
;Integ BumpES and InvertICON calls 
; 1687 bytes/225 bytes saved 
;Function key and kleenup EQU's 
;T4Key fixes 

: 1695 bytes/217 bytes saved 
;New ICON buttons 
: 1726 bytes/186 bytes saved 
; Fix EQU/DB+DW, AR shifts, MUL 
;OIV, Remove useless xOR’s 
:1887 bytes/25 bytes saved 


RDM 17-Sep-85 12:06:15 :Make timeouts disabled on return to UI after diagnostic boot selected by user. Make 

booting mp codes a little prettier by sending the cursor to 2,2 instead of 0.0 and expanding the mp panel background box by 2, 

JAC 16-Sep-85 22:18:37 ;Fix handling of no default boot device 

RDH 16-Sep-85 16:49:45 ;Fix error in ES handling when EEProm is bad and there is a timeout. Fix handling of no 

default boot device. Add code to disable timeouts after running diagnostics. 

RDH 14-Sep-85 9:47:30 :F1 x bug in 35 second timeout. 

RDH 13-Sep-85 18:11:39 ilmprove cursor readability. 

RDH 13-Sep~85 13:34:06 ;Fix up LED's for case where EEProm is bad. 

RDH 13-Sep-85 11:20:22 ;Add DEC AL to default booting code to fix off by one error. 

RDH 12-Sep-85 13:59:34 ;Comment out mouse code. Comment out floppy cleaning and arrow cursor icons. Adjust for 

smaller icon data structure. Move IconSelected code below OeviceKnown code to save on JMP's. 

JAC/RDH 12-Sep-85 11:35:11 ;Add setting of FinishMode./Add timeouts and watching for STOP key. 

RDH ll-Sep-85 13:42:26 ;Fix bug in space saving, Note that INC does not set or clear the Carry flag. 

RDH 10-Sep-85 20:06:28 ;Save space by adding SHORT’S, changing ADD reg, 2 to INC reg x2, changed some loops to 

byte operations. Moved procedures to the end to save a few jumps over them. 



JAC 

10-Sep-85 

14:05:55 

test for short or long diags 
shorten SelectionLoop 


JAC 

6-Sep-85 

11:39:19 

fix border pattern 

display lines aren't a multiple of 4 
add waiting for function key 9 

__ 

JAC 

5-Sep-85 

20:11:15 

fix black line at bottom of display 

unknown device hangs instead of returning to Selection 


JAC 

5-Sep-85 

11:09:37 

fix mp codes and arrow cursor again 
check for function keys 9 and 10 in loop 
remove floppy head cleaning temporarily 

-- 

JAC 

4-Sep-85 

22:48:39 

clear LEDs 

-- 

kek 

4-Sep-85 

19:29:07 

mp codes. 


JAC 

4-Sep-85 

17:15:56 

put in function key 9 checks at beginning 
check prebootSwitches before reading EEPROM 
put cursor at upper left corner while booting 

-- 

JAC 

3-Sep-85 

21:01:59 

fix code at NextDevice 

-- 

JAC 

3-Sep-85 

18:09:34 

first cut at reading EEPROM for available devices 


JAC 

2-Sep-85 

17:51:17 

fixed arrow cursor and line at icon border 
fix unknown device and FloppyHeadClean 

-- 

JAC 

2-Sep-85 

17:00:04 

fix up starting user interface and diagnostics 

-- 

JAC 

2-Sep-85 

16:00:21 

set flag for display instead of calling proc 

" 

JAC 

l-Sep-85 

14:38:24 

fix floppy icon; alt eth boot is now function key 3 
change definition of T9Key and TIOKey 


JAC 

31-Aug-85 

14:32:41 

pop the stack after ChalnUpICONDataStructure loop 


JAC 

29-Aug-85 

14:50:07 

Fix icon booting proc 

-- 

JAC 

27-Aug-85 

17:28:35 

Zero bootOevicelORSpace since ICONS munged It. 


RDH 

23-Aug-85 

18:08:59 

Fix bug above icon and SI smashed by Invertlcon bugs. 


RDH 

23-Aug-85 

8:29:27 

Fix 2 matching bugs in background painting. 


RDH 

22-Aug~85 

16:14:24 

Fix half icon inverted, and mouse click offset problems. 


RDH 

22-Aug-85 

13:29:10 

Fix bugs in mouse tracking, icon inversion, and keyboard watching. 


RDH 

22~Aug~85 

10:56:05 

Add mouse tracking, selection, and selection inversion. 


RDH 

20-Aug-85 

9:50:54 

Fix munge of DS after calling display handler procs. 


RDH 

17-Aug-85 

16:36:50 

Delete error commenting out DisablelnterruptsUntilNextWait. 

-- 

RDH 

17-Aug-85 

16:36:50 

fix up cursor stuff. Add zillions of WaitForSystem's. Comment out 


% 1 D1sablelnterruptsUnti1NextWait. 

RDH 17-Aug-85 14:47:02 ;Changed AH to AL near ButtonlnnerLoop. Add use of SetCursorPattern. Set up DS for 

display handler procs. 

RDH 17-Aug-85 13:23:34 ;Saved ES at NoUnderflow. Restored ES at EnableDisplay. 

RDH 17-Aug-85 11:45:58 ;Added DisablelnterruptsUntilNextWait. 

RDH 16-Aug -85 20:42:11 ;Add set up of BX for ChalnUpICONDataStructure. Fix byteswap problem in SetICONbutton. 

Remove skip over UI. 

RDH 16-Aug-85 15:42:13 ;Add WaitForSystem after before PaintScreenDeskTopGrey. Fix error in loop control on 

WholaD isplayLoop. 

RDH 16-Aug-85 8:32:56 ;Fo1d in JPM.s changes: ";Change reg for new parm to AH" and "Add parm to 

Etherlnitlalize". 

RDH 14-Aug-85 16:15:07 ; Fo1d in changes for UI. 

BKI ll-Aug-85 19:30:28 ;Convert to new EthlOFce 

JPM 22-Jul-85 15:19:49 :Change IOPEInROM alignment to WORD, set up c1 IentCondition in Etherlnitialize IOCBs. 

JPM 15-Jul-85 17:20:38 ;Opie redesign conversion. 

JMM 26-Jun-85 14:44:07 ;Fixed alternate etherbooting support. 
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bki 

21-Jun-85 13:12:45 

;Fixed alternate etherbooting support. 

JMM 

19-Jun-85 17:17:56 

;Added alternate etherbooting support. 

JMM/BKI 

19-Jun-85 15:14:42 

;Changed ethernet fifo limit because of slowed clock 

J PM 

24-May-85 14:58:06 

;Overlay boot changes. 

jmm 

15-Ap r-85 16:60:14 

;Initialize ethernet if present. 

JMM 

25-Feb-85 15:30:45 

:Removed IOPLRAM.asm. 

JMM 

7-Dec-84 12:02:48 

: First release. 

name: 

ROMBoot 


SNOLIST 



$ INCLUDE 

(HardDefs.asm) 


$ INCLUDE 

(IOPDef s.asm) 


SINCLUDE 

(QueDefs.asm) 


$ INCLUDE 

(QueMacro.asm) 


SINCLUDE 

(IOPMacro.asm) 


SINCLUDE 

(ROMBDefs.asm) 


5INCLUDE 

(EthlOFce.asm) 


SINCLUDE 

(DsplDefs.asm) 


SINCLUDE 

(ROMEEP.asm) 


SINCLUDE 

(RAMEEP.asm) 


SLIST 



EXTRN 

BootStrapHandlerlD: ABS 


EXTRN 

DisplayHandlerlD: ABS 


EXTRN 

EthernetHandlerlD: ABS 


EXTRN 

KeyBoardAndMouseHandlerlD 

ABS 

EXTRN 

MaintPanelHandlerlD: ABS 


.(•*********** + ******************** + *♦***** 


IOPELocal RAM 

SEGMENT AT 0 



;from IOPLRAM.asm: 


EXTRN 

HandlerlnitProcTable: 

DWORD 

EXTRN 

prebootSwitches: WORD 


EXTRN 

bootType: BYTE 


EXTRN 

diagType: BYTE 


EXTRN 

finishMode: BYTE 


EXTRN 

sklpUserlnterface: BYTE 

EXTRN 

device: WORD ;VMMDefs.asm 

EXTRN 

baseEthernetFilelD: WORD 

;EXTRN 

cleanFloppyHeadsPROC: 

WORD 

EXTRN 

timeoutEnable: BYTE 


IOPELocalRAM 

ENDS 





:Imported Variables: 
;from IORROM8t.asm: 


BootStrapIOR SEGMENT COMMON 


EXTRN 

EXTRN 

;EXTRN 

EXTRN 

EXTRN 

EXTRN 

;EXTRN 

EXTRN 

EXTRN 

EXTRN 

EXTRN 

;EXTRN 

EXTRN 

EXTRN 

EXTRN 

EXTRN 

EXTRN 

EXTRN 


bootTask: TaskContextBlock ; 

bootStrapTask: TaskContextBlock ; 

jumpTable: BootJumpTable : 

bootOevicelCON: ICONDataStructure ; 
displaySegment: WORD : 

displayOffset: WORD ; 

currentCursor; cursorPosition ; 

bootDevicelORSpace: EtherBootContext 
ICONsBottomEdge: WORD ; 

ICONsTopEdge: WORD : 
displayWidthlnBytes: WORD ; 
EndBootstrapIOR; FAR 
OverlayLength: ABS 
displayStartOffset: WORD 
displayStartSegment: WORD 
bigTimeOut: BYTE 
HttleTlmeOut: WORD 
allowTimeout: BYTE 


BootStrapIOR ENDS 


;from [ORDisp.asm: 


DisplaylOR SEGMENT COMMON 

These two words contain the size 
of the display in bits. 

This = 0 for Daybreak 
or "n" Achip Daisy: 
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EXTRN 

EXTRN 

EXTRN 


numberBitsPerLine: WORD 
numberDisplayLines: WORD 
bitMapOrg: WORD 


















;40000 for Daisy with one AChip. 


EXTRN 

cursorXCoord: WORD 

: After 

putting cursor position here 

EXTRN 

cursorYCoord: WORD 

;set a 

bit in chngdlnfo. 

EXTRN 

borderHigh: BYTE 


EXTRN 

borderLow: BYTE 



EXTRN 
border. 

displCntl; BYTE 

; Bit-3 

<- 0 means display 

EXTRN 

chngdlnfo: WORD 



EXTRN 

cursorPattern: BYTE 

{place 

the display handler looks 



;for cursor bit map. It is not 
;a BYTE but rather 32 bytes. 

Displ aylOR 

ENDS 



;from IOREther 

.asm: 



EthernetlOR 

SEGMENT COMMON 



EXTRN 

etherCmdAvail: Condition 



EXTRN 

etherOutQueue: QueueBlock 



EthornetlOR 

ENDS 



{from IORKeyMo.asm: 



KeyBoardAndMouselOR SEGMENT COMMON 



EXTRN 

HexValue: BYTE 

{ASCII 

value of key down. 

{EXTRN 

MouseX: WORD, MouseY: WORD 

{Delta 

motion change of mouse. 

KeyBoardAndMouselOR ENDS 



{from IORMaint. 

asm: 



MaintPanelI0R 

SEGMENT COMMON 



EXTRN 

maintPanelCode: WORD 



EXTRN 

maintPanelChanged: Condition 


MaintPanelIOR 

ENDS 




BootStrapSTK SEGMENT COMMON 


EXTRN BootStack: WORD 

EXTRN BootStrapStack: WORD 


BootStrapSTK ENDS 


;Initial stack for boot task. 

;initial stack for bootstrap task. 




lOPEInRQM SEGMENT WORD PUBLIC 

ASSUME CS.'IOPEInROM 


PU8LIC 


BootStrapInlt, Etherln i tialize, DisplayMPCode 


EXTRN 

EXTRN 

EXTRN 


DiskBootStrap: NEAR 
EthernetBootStrap: NEAR 
FloppyBootStrap: NEAR 


ROMDskBt.asm 
ROMEthBt.asm 
ROMFlpBt.asm 


;Eor initializing ethernet chips: 

configureParms DB 

11 

{configure byte count 

D8 

OOBH 

:fifo limit (008H for B2) 

DB 

080H 

;bad frame, etc 

DB 

02EH 

{loopback, etc 

D8 

000H 

{backoff parms 

OB 

96 

{interframe spacing 

08 

000H 

:slot time 

DB 

OF 1H 

{retry number 

DB 

000H 

{promiscuous, etc 

DB 

000H 

•.carrier sense, collision 

DB 

64 

;min frame length 

configureParmsSize 

EQU 

$-confIgureParms 

EVEN 



ethernetBootFi1ePrefix 

DW 

%ByteSwap(OOOOOH) {Daisy boot file i 


DW 

%ByteSwap(0AA00H) 


DW 

%ByteSwap(008COH) 


;Boot Keyboard knowledge: 

softKeyWidth EQU 

narrowGap EQU 


:in bits 

;in bits the gap between two softkeys 
: in the same group . 
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wideGap 

; softKeyWidthlnWords 


EQU 

EQU 


56 ;in bits the gap between two groups of softkeys. 

softKeyWidth/16 


;bit offsets of the 

softkeys relative 

fISoftKeyOffset 

EQU 

f2SoftKeyOffset 

EQU 

f3SoftKeyOffset 

EQU 

f4SoftKeyOffset 

EQU 

f5SoftKeyOff set 

EQU 

f6SoftKeyOffset 

EQU 

f7SoftKeyOffset 

EQU 

f8SoftKeyOffset 

EQU 

f9SoftKeyOffset 

EQU 

flOSoftKeyOffset 

EQU 

totalWidthICONS 

EQU 


to the left side of the first softkey. 

0 

fISoftKeyOffset + softKeyWidth + narrowGap 

f2SoftKeyOffset + softKeyWidth + narrowGap 

f3SoftKey0ffset + softKeyWidth + narrowGap 

f4SoftKey0ffset + softKeyWidth + wideGap 

f5SoftKeyOffset + softKeyWidth + narrowGap 

f6SoftKey0ffset + softKeyWidth + narrowGap 

f7SoftKey0ffset + softKeyWidth + narrowGap 

f8SoftKeyOffset + softKeyWidth + wideGap 

f9SoftKeyOffset + softKeyWidth + narrowGap 

flOSoftKeyOffset + softKeyWidth 


bootOeviceCode DB disk,floppy.ethernet,rs232C 


;sizeOfPagelnBytes 
;b1t,sPerWord 
;bit$PerByte 
1inesFromBottom 
;wordsPerLine 
;byt,esPerLine 


DW 

pagesizelnBytes 

DW 

wordBitSize 

DW 

8 

OW 

dlstanceFromBottom 

DW 

16 

DW 

8 


STOPkey EQU 010101008 


KeyBoardBootSelect 

diagBootKeyBaseValue 

bootKeyBaseValue 

numberKeyBaseValue 

leftMouseButton 

rightMouseButton 


EQU 

$ 

EQU 

01100110B 

EQU 

01100010B 

EQU 

10000100B 

EQU 

0000000 IB 

EQU 

00000010B 


Tlkey 

EQU 

01100011B 


T9key 

EQU 

01101011B 


T4key 

EQU 

01100110B 


diagnostics 

EQU 

4 


;Tlkey 

DB 

01100011B 

Disk boot. 

;F2key 

DB 

011001006 

Floppy boot. 

:T3key 

OB 

011001018 

Ethernet boot. 

;T4key 

DB 

01100U0B 


diagnostics 

EQU 

S - Tlkey 


;T5key 

DB 

01100111B 

Disk diag boot. 

;T6key 

OB 

01101000B 

Floppy diag boot. 

;T7key 

OB 

01101001B 

Ethernet diag boo 

;T8key 

OB 

01101010B 


;T9key 

DB 

01101011B 

Not used. 

;TIOkey 

DB 

01101100B 

Floppy head clean 


iconRelativeXcoordinates 


DW fISoftKeyOffset 
DW f2SoftKeyOffset 
DW f3SoftKeyOffset 
DW f4SoftKeyOffset 
DW f5SoftKeyOffset 
DW f6SoftKeyOff set 
DW f7SoftKeyOff set 
DW f8SoftKeyOffset 
DW f9SoftKeyOffset 
DW flOSoftKeyOffset 


Boot Olsplay: 


;1's show as white. O's as black. 

desktopGray EQU 10111011101110118 ;Two full length lines of 

;each of this then shift right 
;twice for two more lines. Repeat 
;over display for desktop gray. 


diskBootICON DW 
DW 
DW 
DW 
DW 
DW 
DW 
DW 
DW 
DW 
DW 
DW 


liniiimiiiiiiB 
UIOOOOOOOOOOIUB 
1100000000000011B 
110011111111001 IB 
1100111111110011B 
1100111111U0011B 
1100111111110011B 
110011111111001IB 
1100111111110011B 
1100000000000011B 
UIOOOOOOOOOOIUB 
111110000001111IB 
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DW 

UOOOOOOOOOOOOUB 


DW 

100111111111100 IB 


DW 

OOOOOOOOOOOOOOOOB 


DW 

OOOOOOOOOOOOOOOOB 

sizeOfICQN 

EQU 

$ - dlskBootlCON 


ethernetBootICON DW 

100000110000Q111B 

DW 

lOOOOOilQOOOOlllB 

DW 

1001001100100111B 

DW 

100100110010011 IB 

DW 

100000110000Q111B 

DW 

100G00110000Q111B 

DW 

11101111110111116 

DW 

OOOOOOOOOOOOOOOOB 

DW 

OOOOOOOOOOOOOOOOB 

DW 

limoitiiuoiiiB 

DW 

1110000011000001B 

DW 

1110000011000001B 

DW 

111001001100100 IB 

DW 

111001001100100 IB 

DW 

lllOOOOOUOOOOOlB 

DW 

1110000011000001B 

floppyBootICON DW 

limiiiiiiiiniB 

DW 

OOOOOOOOOOOOOOllB 

DW 

0000000000000011B 

DW 

OOOOOOOOOOOOOOllB 

DW 

OOOOOOOOOOOOOOllB 

DW 

OOOOOOOOOOOOOOllB 

DW 

000000110000001 IB 

DW 

011101111000001 IB 

DW 

0000001100000011B 

DW 

OOOOOOOOOOOOOOllB 

DW 

OOOOOOOOOOOOOOllB 

DW 

OOOOOOOOOOOOOOllB 

DW 

OOOOOOOOOOOOOOllB 

DW 

OOOOOOOOOOOOOOllB 

DW 

OOOOOOOOOOOOOOllB 

DW 

inn in mi u iib 

floppyHdCleanICON DW 

nnnninnniB 

DW 

nnniinonniB 

DW 

noionnoooniiB 

DW 

1010110000000001B 

DW 

0101010000000000B 

DW 

loioinnooonioB 

DW 

110101110000011 IB 

DW 

ninnoinnoiiB 

DW 

liinnoinnonB 

DW 

ninnoinnoiiB 

DW 

nninonnioiiB 

DW 

lniinoninonB 

DW 

ninnoinnoiiB 

DW 

nninonnioiiB 

DW 

ninnoooooooiiB 

DW 

nnnnninniB 


avai1abtelCONs DW dlskBootlCON.floppyBootICON,ethernetBootICON 


arrowCursor DW OOOOOOOOOlllllliB 

DW OOOOOOOO1111111IB 

DW 0000111111111111B 

DW 000000111111111 IB 

DW 001000111111111IB 

DW 0011000lllllllllB 

DW OOlllOOOlillllllB 

DW 011111000111111 IB 

DW 0111111000111111B 

DW 111111110001U11B 

DW 111111111000111 IB 

DW 111111111100011IB 

DW 111111111110001 IB 

DW llllilllllllOOOlB 

DW lmillllllllOOOB 

DW 11111111111111108 


arrowCursor DW 01111111111111118 

DW 001111111111111IB 

DW 00011111111111118 

DW 000011111111111IB 

DW 000001111111111 IB 

DW OOOOOOllllllllllB 

DW 000000011111111 IB 

dw oooouiiiunniB 

DW 001001111111111 IB 

DW 01100111111111 1IB 

DW 111100111111L111B 
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DW 111100lltlllllllB 
DW 11111001111111118 
0W 1111100111111111B 
DW 11111100lllllllIB 
DW 111111001111111IB 


diaqnosticsICON DW 
DW 
DW 
DW 
DW 
DW 
DW 
DW 
DW 
DW 
DW 
DW 
DW 
DW 
DW 
DW 


iconBorder DW 
DW 
DW 
DW 
DW 
DW 
DW 
DW 
DW 
DW 
DW 
DW 
DW 
DW 
DW 
DW 
DW 
DW 
DW 
DW 
DW 
DW 
DW 
DW 


1110000011111111B 
11110010011111118 
11111001011111118 
OlllllOlOlllllllB 
001110010111111IB 
00010011011111118 
01000111001111118 
001111111011111IB 
100000001101111IB 
11111110010011118 
miiiiiooioouiB 
1111111110110011B 
111111111101100 IB 
1111111111001100B 
111111111110000 IB 
11111111111100118 


10000000000000006 
011111111111111 IB 
01111111111111118 
OlllllllllllllllB 
OltlllllllllltllB 
OlllllllllllllllB 
OlllllllllllllllB 
OlllllllllllllllB 
OlllllllllllllllB 
OlllllllllllllllB 
OlllllllllllllllB 
OlllllllllllllllB 
OlllllllllllllllB 
OlllllllllllllllB 
OlllllllllllllllB 
OlllllllllllllllB 
OlllllllllllllllB 
OlllllllllllllllB 
OlllllllllllllllB 
OlllllllllllllllB 
OlllllllllllllllB 
OOOOOOOOOOOOOOOOB 
10000000000000008 
1100000000000000B 


OOOOOOOOOOOOOOOOB, 
111111111111111 IB, 
lllllllUlllllllB. 
imiiiiitiiiniB, 
111111111111111 IB, 
ltiiiiiiiiiiiiiiB , 
11111111111111118, 
liiiimiiiiiiiiB, 
11111111111111116, 
iiiiiiiiiiiimiB, 

111 till11111111IB, 
tlULlllllllllllB. 
limuiiuiiuiB, 
liiiiiiiiiiuiiiB. 
lllllllUlllllllB, 
liiiiiiiiiiuiiiB, 
lllllllUlllllllB, 
lllllllUlllllllB, 
liiiiiiiiiiuiiiB, 
liiiiiiiiiiuiiiB, 
uiiiiiiiiiiiiiiB. 
OOOOOOOOOOOOOOOOB, 
OOOOOOOOOOOOOOOOB, 
OOOOOOOOOOOOOOOOB, 


OOOOOOOOOOOOOOOOB. 

inn iiiiiii hub, 

llllllllllHlUlB, 

liiiiiiiiiiuiiiB, 

11111111111111118, 

liiiiiiiiiiuiiiB, 

uiiumimuiB. 

uiiiiiiiiiiiiiiB, 

llllllllllHlUlB , 
U11H1111UU11B, 
UlllllUUlllUB, 
niiiinuuuiiB, 
unnuiiuiiiiB, 
lUlUUllUUHB, 
lllllllUlllllllB, 
UlllllHllUlUB, 
UIIIIIIIIIIIIIIB, 
llllllll 1111H11B, 
lllllllUlllllllB, 
111111111111111 IB, 
luiinniuiniB , 
OOOOOOOOOOOOOOOOB, 
OOOOOOOOOOOOOOOOB, 
OOOOOOOOOOOOOOOOB, 


00000000000000106 

nillllUllllOOlB 

111U11111U1000B 

uunniunoooB 

uiininiiiioooB 

11111HU11HOOOB 
lllllllllllllOOOB 
11111111111110008 
nninuniioooB 
lununiiuoooB 
mini minoooB 
mmmnuoooB 
UimmUHOOOB 
uuimimioooB 
mmimmoooB 

UUH1111111000B 

nuimmuoooB 

mmimmoooB 

lUUUHllHOOOB 

mmimmoooB 

limmimooooB 

OOOOOOOOOOOOOOOOB 

00000000000000018 

0000000000000010B 


;EPROM 8oot Data: 

bootDeviceProc DW 
DW 
DW 
DW 


unKnownDevice, DiskBootStrap, FloppyBootStrap 
A1tEthernetBoot, unKnownDevice, DiskDiag 
FfoppyDiag, EtherDiag, unKnownDevice 
unKnownDevice, unKnownDevice 


bootDevicesMask 

EQU 

01E0H 

bootDevicesToLow 

EQU 

5 

floppyAndEthernet 

EQU 

S 

dont.T rustEEProm 

EQU 

8000H 

shortDiag 

EQU 

0 

longDiag 

EQU 

1 

DiagLEDsTo2 

EQU 

200H 


;off-on-off This should match def 


in Preboot. 


-- Initial entry: 

- Initialize the task bootTask, Jam it, and initialize . 

- bootStrapTask to start with the user interface. 

- bootTask is the boot device independent task. It sets up 

-|buffers for bootStrapTask to fill. It then interprets those 

-jbuffers. running initial code, loading control store with 

-(microcode, loading ram handlers, etc. bootStrapTask is the 

-(device specific task. It knows something about the boot 

-(devices. It fills the buffers with data from the boot device. 

-(Communication between these two tasks is accomplished by the 

-(conditions getBootFile, bootBufferFul1, bootBufferEmpty, and 

-j finlshedloaderFileFetch. 


Boot.StrapInit PROC FAR 

%InitializeTask (BootStrapHandlerlD.OFFSET bootTask,JamBootTask,OFFSET BootStack) 

JamEiootTask: %Jam (BootStrapHandlerlD.OFFSET bootTask) ; to be restarted by 

idevice specific code. 

;to be resolved later. 

•^Initial izeTask (BootStrapHandlerlD .OFFSET bootStrapTask .Userlnterface .OFFSET BootStrapStack) 
RET 
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BootStrapInit 


ENDP 


-- User Interface: 

Put up the icons. Wait for a key stroke or a mouse click selecting what 
type of boot to do. 


User-Interface 


PROC 

FAR 


ASSUME 

DS:BootStrapIOR 


MOV 

AX, IOPELocalRAM 

;load low RAM address 

MOV 

ES. AX 

; into ES 

ASSUME 

ES:IOPELocalRAM 


CMP 

skipUserlnterface. 

normal 

JE 

StartUserlnterface 


JMP 

BootDeviceSelection 

; if doing diagnostics 


StartUserlnterface: 

%Cal1HandlerlnitProc 
%WaitForSystem 


(KeyBoardAndMouseHandlerlD) 


PUSH 

MOV 

CMP 

ONE 

MOV 

MOV 


ES 

diagType, shortDiag 
prebootSwitches, dontTrustEEProm 


;did preboot indicate checksum is bad? 


CheckFunctionKey9 
AX, KeyBoardAndMouselOR 
ES. AX 


;no, go see if user wants to ignore anyway 
;yes, can't proceed until user hits function key 9 


ASSUME ES: KeyBoardAndMouselOR 


Wai t;ForF9: 


Cl earLEDs: 


MOV 
OUT 

SetPrebootSwitches: 

MOV 

POP 


MOV AX. DiagLEDsTo2 

OUT WriteConfigReg, AX 

MOV AL, HexValue 

CMP AL. T9key 

JE ClearLEDs 

%WaitForSystem 
JMP SHORT WaitFo rF9 

AX, 0 

WriteConfigReg, AX 


HexValue, 0 
ES 

ASSUME ES:IOPELocalRAM 
MOV 
JMP 


;Set LED's to give indication 
that EEProm is bad. 


;turn off Teds that preboot left on to indicate 
: that checksum was bad 

;just in case. 


prebootSwitches, dontTrustEEProm 
SHORT InitDisplay 


PauseForFQ: PUSH BX 

%WaitForSystem 
JMP SHORT TryAgain 

CheckFunctionKey9: 

%GetInterval Timer 
ADD AX. 2000 

PUSH AX 

%EstablishHandlerAccess(KeyBoardAndMouseHandlerID) 

T ryAgain: 


returns value in AX 
wait for -2 seconds 


ASSUME 

ES: KeyBoardAndMouselOR 



MOV 

AL, HexValue 



POP 

BX 



CMP 

AL, T9key 

idoes user want to ignore 

EEPROM? 

JE 

SetPrebootSwitches 

;yes, indicate that 


CALL 

HasTimeElapsed 

;hasn’t said so yet; see 

if our waiting 

JL 

PauseForF9 




ProceedWithUserlnterface: 

POP ES 


ASSUME ES:IOPELocalRAM 


InitDisplay: 


’/.Call Handl erlni tProc 
%CallHandlerlnitProc 
%WaitForSystem 
PaintScreenOeskTopGrey: 

MOV AX, DisplaylOR 

MOV ES, AX 

ASSUME ES:DisplayIOR 
SetUpDisplayMemoryAccess: 


(MaintPanel HandlerID) 

(DisplayHandlerlD) 

;Let display and keyboard handlers run. 


MOV CX, bitMapOrg 

MOV DX, CX 

SHR CX, byteLength 

SHL DX, byteLength 

MOV CH, extendedBusOpieAddres 

PUSH ES 

%EstablishlOPAccess(generalMapReg 
MOV DisplaySegment, ES 

MOV Di splayOffset, DI 

MOV displayStartSegment, ES 

MOV displayStartOffset, 01 

POP ES 

MOV BX, DI 

MOV AX. numberBitsPerLine 

SHR AX, 4 

PUSH AX 

MOV SI, AX 

SHL SI. 1 


The first thing we want to do is paint 
the whole display desktop grey. So first 
get the display memory mapping from 
Opie. 


MOV DI, numberDisplayLines 

SHR DI, 2 


ister.CX-DX) 

ES:DI points to beginning of 
display memory. 

Save pointer for later use in 
making booting MP codes legible. 

Get ES back to DisplaylOR. 

We are going to write out the pattern a word 
at a time per each two lines. We therefore 
need to know how may words per line this 
display has. This information is made 
available to us by the Display handler. 

The desktop grey pattern is made up of 
lines of an alternating pattern where each 
pattern takes up two lines at a time. So 
since we will fill up four lines at a time 
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WholeOisplayLoop 


DonePainting: 


A1 ILinesPainted: 


MOV 

displayWidthlnBytes, 

SI 

we need to know how many sets of four full 



;display lines the current machine has. 

MOV 

CX, DisplaySegment 


Set ES up to point into display. 

MOV 

ES, CX 

;U$e segment override for display. 

PUSHA 



Save state and let someone else have a chance. 

%WaitForSystem 



POPA 




MOV 

AX, desktopGray ;get background pattern for even lines 

POP 

CX 



PUSH 

CX 



CALL 

DoLine 

;paint even lines of background pattern 

ROR 

AX, 2 

;get background pattern for odd lines 

POP 

CX 



PUSH 

CX 



CALL 

DoLine 

;paint odd lines of background pattern 

DEC 

DI 

;are we done yet? 

JNZ 

WholeDisplayLoop 



;we need to special case the 

last 

line because the number of display lines is not 

;an even multiple of 4. this 

is 

true for both 17 and 19 inch displays 

MOV 

AX, desktopGray ;get 

background pattern for even lines 

POP 

CX 



PUSH 

CX 



CALL 

Fi11 Line 



MOV 

AX. ES 

;Save possibly incremented ES into 

MOV 

DisplaySegment, AX 

•.DisplaySegment 

MOV 

AX. DIsplaylOR 



MOV 

ES, AX 

;Now use ES to access displaylOR. 

ASSUME 

ES:DIsplaylOR 



POP 

AX 

;now figure out how to position the ICONs. 

MOV 

CX, AX 



SHL 

AX, 1 


AX gets bytes per 1ine 

MUL 

CS: 1 InesFromBottom 


The ICONs will be a given distance from the 

SUB 

BX, AX 


the bottom of the screen regardless of the 

JNC 

NoUnderf1ow 


size of the screen. Some display memories 

MOV 

DX, DisplaySegment 


are larger than can be represented by 16 bits. 

SUB 

DX, cros$over64Kb8ank 

Move DisplaySegment back a segment 

MOV 

DisplaySegment, DX 




NoUnderflow: 


;Ca1culate bit offset in display line to first icon. 

;Keep icons centered 

; If there is ever a display narrower than 
;the icons, look out. 

;Save bit offset of first ICON on stack. 
iConvert bit offset to bytes 
;BX points to corner of first ICON 

;Save the base value of the beginning of the icon area. 
;displayOffset is now a pointer to the upper lefthand corner of the first icon. 


MOV 

AX, numberB itsPerLine 

SUB 

AX, totaIWidthICONS 

SHR 

AX, 1 

PUSH 

AX 

: SAR 

AX, 3 

; ADD 

BX, AX 

MOV 

displayOffset, BX 


InitializoICONs: 


Se tup ICONs: 


: Set 

up the Icon's data structure. 


MOV 

CX, numberOfSoftKeys 

;The first thing we want to do is to 

MOV 

DX. OFFSET bootDevIcelCON 

: set up the ICON data 

MOV 

BX, DX 

structures such 

MOV 

DI, Null 

;that the ICONs are positioned appropriately 
;on the screen, i.e. towards the bottom 

MOV 

AX, numberDisplayLines 

;of the screen and centered. At the same 

SUB 

AX, dlstanceFromBottom 

;time we want to link the ICON data 

MOV 

ICONsTopEdge, AX 

Structures so that we can manipulate the 

ADD 

AX, ICONInnerOepth 

;user interface bitmap a bit more easily. 

MOV 

ICONsBottomEdge, AX 


XOR 

SI. SI 


POP 

AX 

;We had saved first ICON bit offset here. 

PUSH 

AX 

•.Keep it available. 


ChainUpICONDataStructure: 

PUSHA ;Save state and let someone else have a chance. 

%WaitForSystem 

POPA 


ADD 

ADD 

MOV 

MOV 

;MOV 

; MOV 

; ADD 

MOV 

MOV 

MOV 

MOV 

XOR 

SHR 

ADD 

MOV 

;Prepa 

POP 


AX, iconRelativeXcoordinates[SI] 

DX, SIZE bootDevicelCON 
[BX].ICONLeftlmagePtr, Null 
[BX].ICONRightImagePtr, Null 
[BX].1eftBoundary, AX 
[BX].rightBoundary, AX 
[BX].rightBoundary, softKeyWidth 
[BX].bootingProcedure, OFFSET unKnownDevice 
[BX].nextICON. DX 
[BX].invertedICON , notlnverted 
DI 


;Get bit offset for this icon. 

;Each ICON’S data structure will point to 
;both the next ICON on the right and on the 
;left. For any side without an ICON, the 
ipointer there is NULL (=0). 


;This is not used!!!M 


[BX].previousICON 
DX, DX 
AX, 3 

AX. displayOffset 
[BX].ICONOffset, AX 
re for next iteration 
AX 


;Make AX pointer to corner of icon 


;AX gets first ICON bit offset. 
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PUSH 

AX 

;Keep it on the stack. 

MOV 

DX, [BX].nextICON 


MOV 

DI, BX 


MOV 

BX, DX 


INC 

SI 


INC 

SI 


LOOP 

ChalnUpICONDataStructure 


POP 

AX 

{Return stack to normal 

MOV 

[DI].nextICON, Null 

{Make last pointer null 


GetAvailab!eDevices: 

MOV 
MOV 
ASSUME 
CMP 
JNE 
MOV 
JMP 

GetDevIcesFromEEProm: 

%ReadEEProm(eeProm8ooting,1) 
AND AX, bootDevicesMask 

SAR AX, bootDevicesToLow 

;ReadEEPROM(AvailableOevices) 


AX, IOPELocalRAM 
ES, AX 

ES; IOPELocalRAM 

prebootSwitches, dontTrustEEProm 
GetDevicesFromEEProm 
AX, floppyAndEthernet 
SHORT InitPointers 


•.just get available devices 
;put in least significant byte 
; jmm:85-03-27 



;MOV 

AX,07 

{Disk, floppy and 

ethernet available. 

InitPo inters: 

MOV 

CX, 

numberOfICONs 



MOV 

BX, 

OFFSET 

availablelCONs 

BX points to array of pointers 
to icon bitmaps. 


MOV 

SI. 

OFFSET 

bootDeviceProc+2 

SI points into array of boot procs. 


MOV 

01, 

OFFSET 

bootOevlceCode 

DI points to array of device codes. 

offsetToDiag 

MOV 

BP, 

EQU 

OFFSET 

bootDevicelCON 

(SIZE bootDeviceICON)*4 

BP points to first icon data structure. 

off setToBootD 

Initialize: 

iag 

PUSHA 

EQU 


8 {offset in bootDeviceProc to get from device to device dlag 

;4 devices *2 words each 

{Save state and let someone else have a chance. 


"ZWaitForSystem 

POPA 


NextOevice: 


ROR 

JNC 

MOV 

MOV 

MOV 

MOV 

MOV 

MOV 

MOV 

MOV 

MOV 

MOV 

MOV 

MOV 

MOV 

INC 

INC 

INC 

INC 

INC 

MOV 

LOOP 


AX, 1 

NextDevice ;Skip unavailable devices. 

DX, CS: [8X] ;DX points to icon bitmap 

DS: [BP].ICONLeftlmagePtr, DX ;Set up bitmap pointers 

DS: [BP][offsetToDiag].ICONLeftlmagePtr, DX 

DS: [BP][offsetToDiag].ICONRightlmagePtr, OFFSET diagnosticsICON 


DX, CS: [DI] 

DS: [BP].bootDevice, DL 
DS: [8P][offSetToDiag].bootDevice, DL 
DS: [8P].typeOfBoot, normal 
DS: [BP][offsetToDiag].typeOfBoot, diagnostic 
DX, CS: [SI] 

DS: [BP].bootingProcedure, DX 
DX, CS: [SI+offsetToBootDiag] 

DS: [BP][offsetToDiag].bootingProcedure, DX 

BX 

BX 

DI 

SI 

SI 

BP, DS: [BP].nextICON 
Initialize 


;DX holds device code. 

;Set boot device. 

:Set boot device for diagnostic button 
;Set type of boot 

:DX points to boot proc 
;Set boot proc 

:Set diagnostic boot proc 
;Point to next available 
: icon 

;Nex't boot device 
:Next boot device proc 

:Prepare endloop. 


Setup ICONSinDIsplayMemory: 



{Dump 

the ICON images into display memory. 


MOV 

BX, DIsplaySegment 



MOV 

ES, BX 

;Make ES point Into display memory. 


MOV 

BX, OFFSET bootDevicelCON 

{Point to first icon data structure. 

SetUpAllICONS: 

PUSHA 

{Save 

state and let someone else have a chance 


%WaitForSystem 



POPA 




CALL 

SetICONbutton 

{Paint in button. 


CMP 

[BX].ICONLeftlmagePtr, 0 



JE 

GetTheNextICON 



CALL 

SetUpDeviceSymbol 



CALL 

SetUPOeviceDiagSymbol 


GetTheNextICON: 

MOV 

BX, [BX].nextICON 



OR 

BX, BX 

;Th1s will be zero if the ICON we 


JNZ 

SetUpAllICONS 

;just finished was the last one. 

EnableDisplay: 

MOV 

AX, DisplaylOR 

{Allow access to Display’s 10 region. 


MOV 

ES, AX 



ASSUME 

ES: DisplaylOR 



ES must be pointing into DisplaylQR when this code is executed. 
SetCursorPattern: 


Curso rFi11 In; 


XOR 

SI. 

SI 

XOR 

DI, 

DI 

MOV 

CX, 

16 

MOV 

AX, 

arrowCursor[SI] 

MOV 

cursorPattern[OI], AH 

15- 

-Jan-87 

13:54:53 PST 
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MOV 

cursorPattern[DI+-ll, AL ; 



INC 

SI ;We should not Initialize the cursor until 


INC 

SI ;after we have initialized the display pattern. 


INC 

DI 



INC 

DI 



LOOP 

CursorFil1 In 



MOV 

displCntl, hideCursorDisplayOn 



MOV 

borderLow, OBBH 



MOV 

borderHiqh, OEEH 



;The display handler procs called through 

commandProc and 


:cursorPatternProc think that DS contains 

displaylOR. 


OR 

chngdlnfo, commandChngd 



OR 

chngdlnfo, cursorPatternChngd 



OR 

chngdlnfo, borderPatternChngd 


Selection: 

;Timer 

stuff. 



MOV 

bigTimeOut, timeoutlnterval 

Put number of seconds to wait in timeout counter. 


MOV 

AX, IOPELocalRAM 

Make ES point into 


MOV 

ES, AX 

data area for 


ASSUME 

ES: IOPELocalRAM 

timeoutEnable. 


MOV 

finishMode, backToUI 

Set flag for diagnostics to know 




to go back through the user interface 




A default diagnostics boot will 




have finishMode set to bootSystem. 


MOV 

AL, timeoutEnable 

Get timeoutEnable flag. 


MOV 

allowTImeout, AL 

Save flag in own loregion. 

SetShortTimer: 

%GetIntervalTimer 

Put timeOfDay In AX. 


ADO 

AX, oneSecond 

AX has short termination time in milliseconds 


MOV 

1ittleTImeOut, AX 

Save short timeout. 

SelectionLoop: 

%WaitForSystem 

Let something happen. 


XOR 

AX, AX 



MOV 

SI, OFFSET KeyBoardBootSelect 



MOV 

DL, Tlkey 



MOV 

AX, KeyBoardAndMouselOR 

Set up ES for access 


MOV 

ES, AX 

to keyboard values. 


ASSUME 

ES:KeyBoardAndMouselOR 



MOV 

AL, HexValue 



MOV 

CX, 10 


WhatDevice: 

CMP 

AL, DL 

check for normal boot 


JE 

DeviceKnown 



INC 

DL 



LOOP 

WhatDevice 


;CheckMouse: 

CMP 

AL, leftMouseButton 

Check mouse buttons 


JE 

Click 



CMP 

AL, rightMouseButton 



JE 

Click 



PUSH 

AX 

Save AX for stop key checking. This will come out w 

;TrackMouse: 

CALL 

GetMouseCoords 

Get current mouse position. 


PUSH 

DS 

Save DS. 


MOV 

CX, DisplaylOR 

Set DS to DisplaylOR 


MOV 

DS. CX 



MOV 

DS: cursorXCoord, AX 

Tell display handler where cursor is. 


MOV 

DS: cursorYCoord, BX 



OR 

DS: chngdlnfo, cursorPositionChngd ;Have display handler set cursor position. 


POP 

DS 

Restore DS to BootStrapIOR> 


POP 

AX 

Get the value of HexValue back into AL.. This shou 

tracking ode. 





:Check 

for stop key and timeout. 



CMP 

AL, STOPkey 

Check for stop key. 


JE 

StopKeyPushed 

Go clear the timeoutEnabled flag. 


TEST 

allowTimeout, timeOutEnab 

Check timeoutEnabled flag. 


JZ 

TImeOutDIsabled 

Go fix stack and do loop again. 


MOV 

BX, 1ittleTimeOut 

Get timeout time into BX. 


CALL 

HasTimeElapsed 

Returns compare of current-time-of-day, BX (BX is ti 


JL 

SelectionLoop 

If second over check bigTimeOut otherwise wait some 


DEC 

bigTImeOut 

Decrement number of seconds left. 


JNZ 

SetShortTimer 

If nonzero go back and restart short timer. 

TimedOut: 

;Check 

EEProm for default boot device and 

default mode. 


; Th i i 

mplementation assumes that if the 

eeprom is bad the default default 


: is to 

wait indefinitely for user input. 



MOV 

AX, IOPELocalRAM 



MOV 

ES, AX 



ASSUME 

ES:IOPELocalRAM 



MOV 

finishMode, bootSystem 

Tell diagnostics not to return to UI 


%ReadEEProm(eePromBooting, 1) 



JNC 

HaveDefaultDevice 

See if eeprom is ok. 

BadEeprom: 

: PUSH 

AX 

Put filler on stack. 

TimeOutDIsabled 




StopKeyPushed: 

MOV 

allowTImeout, timeOutDisab 

Clear timeout enabled flag. 


JMP 

SHORT SelectionLoop 

Wait for action. 

HaveOefaultOevice: 




AND 

AX, OFH 

Mask out all but default device bits, 


JZ 

TimeOutDisabied 

if no default boot devices in EEPROM then disable ti 


PUSH 

AX 

Save AL to make into index for bootdeviceProc 


%ReadEEProm(eePromMisc, 1) 

Do diags by default? 


JC 

BadEeprom 

See if eeprom is ok. 


TEST 

AL, 1 

Test the def diags bit. 


POP 

AX 

POP does not affect flags. 


should come out with the mouse 
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JZ 

NoDefDiags 


ADD 

AL, diagnostics 

NoDefDlags: 

DEC 

AL 

JMP 

SHORT GetlconDataStrucPtr 

;FoundKeyMatch: 

POP 

BX 


POP 

BX 


JMP 

DeviceKnown 


;Change index to indicate the analagous diag boot. 

;There is no zero Icon data structure. The Index must be shifted by l. 
;Go use AL to get the right icon data structure and boot therefrom. 

;Clear timeoutEnable and 
! timeout time from stack. 


Click; ;A mouse button has been pushed. See if cursor is over icon. 

%'EstablishHandlerAccess(KeyBoardAndMou$eHandlerlD) 

ASSUME ES: KeyBoardAndMouselOR 



CALL 

GetMouseCoords 


CMP 

BX, ICONsBottomEdge 


JG 

NotOverlcon 


CMP 

BX, ICONsTopEdge 

ChockXPos: 

JL 

NotOverlcon 


MOV 

CX, numberOfSoftKeys 


MOV 

DI, OFFSET bootDevicelCON 

ChockXPosLoop: 

CMP 

AX, DS:[DI].rightBoundary 


JG 

NotThisOne 


CMP 

AX, DS:[DI].1eftBoundary 


JGE 

IconSelected 

NotThisOne: 

ADD 

DI, SIZE ICONDataStructure 


LOOP 

CheckXPosLoop 

NotOverlcon: 

MOV 

HexValue, 0 


JMP 

T rackMouse 


;Get current mouse position, 
;See if cursor is below icons. 

;See if cursor is above icons. 


;Check the icon data structures for the xoocrdinate. 
;DI points to first icon datat structure. 

;$ee if cursor is right of the icon. 

;See if cursor is left of the icon. 

;Point to next one. 


;Oon’t see another click until there is one. 
;Move the cursor and wait again. 


DevIceKnown: ;Invert the icon corresponding to 

;PUSH AX 

ASSUME ES: KeyBoardAndMouselOR 

MOV HexValue, 0 

SUB AL. TIKey 

CMP AL, diagnostics 

JL GetlconDataStrucPtr 

MOV allowTimeOut, timeOutDisab 

GetlconDataStrucPtr: 

MOV BL, SIZE ICONDataStructure 

MUL BL 

MOV DI, OFFSET bootDevicelCON 

ADD DI. AX 

;PUSH SI 

;CALL InvertICON 

:POP SI 

;POP AX 

:JMP IconSelected 


the key pressed. 

:Save key value. 

;why does the assembler get confused here? 

;Get key offset. 

;Before we join with the default code 
; check for a diagnostic boot and 
; disable timeouts for after diagnostics run. 
;Default booting enters here. 

jConvert key value to pointer to icon data structure 
;Make AX index the array of icon data structures. 
:Set up base of array 

;DI points to correct icon data structure. 

;Invert that icon! 
jRestore key value. 


IconSelected: 

:DI points to ICONDataStructure to be inverted, 

;After this proc the icon is inverted and AX, CX, SI, BX are smashed. 
InvertICON: 


InvertOuterLoop 

InvertlnnerLoop 


PaintSquare: 


NOT 

DS:[DI].invertedICON 

;Toggle inverted flag. 

PUSH 

ES 


MOV 

AX, DS:displaySegment 


MOV 

ES, AX 


MOV 

CX. ICONInnerDepth 

;Prepare line counter. 

MOV 

SI, DS:[DI].ICONOffset 

;ES:SI points to corner of icon. 

XOR 

BX, BX 

;Prepare byte counter. 

NOT 

BYTE PTR ES:[SI][BX] 

; invert a byte. 

INC 

BX 


CMP 

BX, softKeyWidth/8 

;bytes across softkey. 

JNE 

InvertlnnerLoop 


ADD 

SI, DS: dlsplayWidthlnBytes 


LOOP 

InvertOuterLoop 


POP 

ES 


;Paint 

a square of the upper left hand corner of display memory white 

: to provide a pretty background for the 

maintenance panel. It must be 

; a little bit bigger than the 16x16 cursor to provide good legibility. 

MOV 

SI, displayStartOffset 

•,Get pointer to the beginning 

MOV 

AX, displayStartSegment 

; of the display bank. 

MOV 

ES, AX 


ASSUME 

ES:NOTHING 

;Assembler doesn't know about display bank. 

MOV 

AX, OFFFFH 

;Load big paint brush with white paint. 

MOV 

BL, maintPanelBkGrdRightPad 

;Load little brush with a little paint. 

MOV 

CX, malntPanelBkGrdHeight 

;Mark out height of area to paint. 

MOV 

ES:[SI], AX 

;A stroke with the big brush. 

OR 

ES : [SI+-2] , BL 

;A dainty stroke with the little brush. 

ADD 

SI. displayWidthlnBytes 

;Move scaffolding down to the next line. 

LOOP 

PaintSquare 

;Are we done yet?? 

MOV 

CX, DisplaylOR 

;Return cursor to upper left corner of scree 

MOV 

ES, CX 


ASSUME 

ES: DisplaylOR 


MOV 

cursorXCoord, mpcodeCursorXPos 


MOV 

cursorYCoord, mpcodeCursorYPos 


MOV 

displCntl, niceMPDisplayOn 


OR 

chngdlnfo, cursorPositionChngd 


OR 

chngdlnfo, backgroundChngd 


;quick 

slip in a s1 imy mp code! 


MOV 

AX, mpStartBooting 
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CALL DisplayMPCode 

MOV BX, IOPELocalRAM 

MOV ES, BX 

ASSUME ES:IOPELocalRAM 

MOV AL, DS:[DI].bootDevice 

CBW 

MOV device, AX 

MOV AL, allowTimeout 

MOV tlmeOutEnable, AL 


;this does a wait for system 

;Set up access to local ram segment. 


Set boot device variable. 
Make it a word 


Save the state of timeouts 
for after diagnostics run, 
if they do. 



CMP 

DS:[DI].typeOfBoot, normal 


JE 

ItsNormal 


MOV 

bootType, diagnostic 


JMP 

SHORT CallBootProc 

ItsNormal: 

MOV 

bootType, normal 

Cal 1BootProc: 

MOV 

AX, [DI].bootingProcedure 

ZeroBootDevicelORSpace: 



MOV 

BX, OFFSET(bootDeviceEORSpace 


MOV 

CX, OverlayLength 


XOR 

SI, SI 

ZeroLoop: 

MOV 

BYTE PTR [8X + SI], 0 


INC 

SI 


LOOP 

ZeroLoop 


JMP 

AX 


;See if its a diagnostic bot. 

;It's diagnostic boot. 

;It‘s normal boot. 

jclearing ioregion will smash this 

jclear ioregion for device specific code 
;get number of bytes to be cleared 

;Boot. 


;Set parameters in low memory and start booting. 

;MOV BX. IOPELocalRAM 

;MOV ES, BX 

;ASSUME ES:IOPELocalRAM 

;CMP AL, CS: [SI] ;check for diag boot 

;JE MonOiagBoot ; 

;SU8 AX, diagBootKeyBaseValue 

;MOV bootType, diagnostic ; 

;JMP GoBoot 

:NonDiagBoot: SUB AX, bootKeyBaseValue 

;MOV bootType. normal ; 

;GoBoot: MOV device, AX ; 

:CALL ZeroBootDevicelORSpace idevlce specific code assumes this is zero and icons munged it 

Mouselnterpreter: 

KeyBoardlnterpreter: 

D1splayInterface: 

Boot.Dev iceSe lection: 



ASSUME 

ES:IOPELocalRAM 


MOV 

SI, device 


SHL 

SI. 1 


JMP 

WORD PTR CS: bootDeviceProc[SI] 

DiskDiag: 

CALL 

ShortOrLongOiag 


JMP 

DiskBootStrap 

FloppyDiag: 

CALL 

ShortOrLongOiag 


JMP 

FloppyBootStrap 

EtherDiag: 

CALL 

ShortOrLongDiag ;Note this assumes A1tEthernetBoot is directly below 


A1tEthernetBoot: 

CMP skipUserlnterface, normal 

JNE StartEthernetBoot 

%WaitForTime (3000) 

MOV AX, KeyBoardAndMouselOR 

MOV ES, AX 

ASSUME ES:KeyBoardAndMouselOR 

MOV AL, HexValue 

SUB AL, numberKeyBaseValue 

CMP AL, 01 

JL OefaultAltBoot 

CMP AL, 07 

JLE SelectedAltBoot 

DefaultAltBoot: MOV AL, 0 

SelectedAltBoot: 

MOV BX, IOPELocalRAM 

MOV ES, BX 

ASSUME ES:IOPELocalRAM 

;JMP SHORT ProceedEthernetBoot 

;EthernetBoot: XOR AL, AL ;pr1mary suffix 

ProceedEthernetBoot: 

MOV CX, 6 ; 

MOV 01, OFFSET baseEthernetFi1elD ; 

MOV SI, OFFSET ethernetBootFilePrefix 

CLD 

StoreEthernetFilelO: 

MOVS BYTE PTR ES:[DI], CS:[SIJ : 

LOOP StoreEthernetFilelD 

OR ES:[DI - 1], AL ;$et suffix (by OR’ing, not MOV’ing!). 

StartEthernetBoot: 

JMP EthernetBootStrap 

ShortOrLongOiag PROC NEAR 

PUSH ES 


;see note at EtherDlag 
;Give user time to select 

;an alternate boot. 
;Choice$ are 1 thru 7. 

alternate suffix 
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;wait for ~ 1 second 


WaitForLong: 


SetL.ongDiag: 


%GetInterval Timer 
ADD AX, 1000 

PUSH AX 

MOV CX, device ;push pointer to IOPELocalRam 

ADD CL, T4key idetermine if same key was pressed again to 

%EstablIshHandlerAccess(KeyBoardAndMouseHandlerlD) 

ASSUME ES: KeyBoardAndMouselOR 
CMP HexValue, CL 

POP BX 

POP ES 

ASSUME ES: IOPELocalRam 
JE SetLongDiag 

CALL HasTimeElapsed 

JGE ShortOrLongRet 

PUSH ES 

PUSH BX 

JMP SHORT WaitForLong 

MOV diagType, longDiag 


ShortOrLongRet: RET 
ShortOrLongDiag ENDP 


;PARAMETERS: 8X has been set with the value that the interval timer should read when 

;time has elapsed. 

;SMASHES: AX 

;RETURNS ends with a compare so flags are set accordingly 

HasTimeElapsed PROC NEAR 

%GetInterval Timer 
CMP AX, BX 

RET 

Hasl'imeElapsed ENDP 


FIoppyHeadClean: 

jquick slip in another slimy mp code! 

;M0V AX, mpFloppyCleaning 

;CALL DisplayMPCode 

;CALL DWORD PTR c1eanFloppyHeadsPROC 


unKnownDevice: 

MOV 

CALL 

StayHere: JMP 


AX, mpDeviceUnknown 
DisplayMPCode 
SHORT StayHere 


;this really should do a Jam 


User-Interface ENDP 

ASSUME DS:NOTHING, ES:NOTHING 


BitsToDisplayPROCs 


PROC NEAR 


ASSUME DS:BootStrapIOR 


topAndBottomEdgePat 
left.EdgePatByteSw 
rightEdgePatByteSw 
centerPat 
1inesInCenterPat 
byteButt 


EQU 

Oh 

EQU 

0FF7Fh 

EQU 

0F8FFh 

EQU 

OFFFFh 

EQU 

20 

EQU 

4 


: entry, BX has icon index 
: ES to display mem 
SetICONbutton: MOV 
CALL 
MOV 

PaintCenterPat: 


SI, [BX].ICONOffset 
PaintTopBottomEdges 
CX, IInesInCenterPat 


PUSH SI 

MOV ES:[SI]. leftEdgePatByteSw 

MOV ES:[SI+2], centerPat 

MOV ES:[SI+4], centerPat 

MOV ES:[SI+6], rlghtEdgePatByteSw 

POP SI 

ADO SI, disp layWidthlnBytes 

LOOP PaintCenterPat 

CALL PaintTopBottomEdges 

CALL PaintTopBottomEdges 

CALL PaintTopBottomEdges 

RET 

;entry SI point where painting to begin, exit SI points to byte below 
;ES to display mem 
PaintTopBottomEdges: 

MOV CX, byteButt 

PUSH SI 


PaintTopBottomLoop: 

MOV WORD PTR ES:[SI], topAndBottomEdgePat 

INC SI 

INC SI 

LOOP PaintTopBottomLoop 

POP SI 

ADD SI, displayWidthlnBytes 

RET 


it in icon pix 
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SetUpDeviceSymbol: 

MOV 01, [BX] .ICONLeftlmagePtr 

OR 01, DI 

JZ LetsGetOut 

MOV AX, displayWidthlnBytes 

; XOR DX, DX 

MOV SI, vertlconOffsetlnButton 

MUL SI 

MOV SI, [BX].ICONOffset 

ADO SI, AX 

ADD SI, lefUconOffsetlnButton 

MOV CX, 16 

MoveDeviceSymbol: 

MOV AX. CS: [DI] 

MOV ES: [SI], AH 

MOV ES: [SI+1], AL 

INC DI 

INC DI 

ADD SI, displayWidthlnBytes 

LOOP MoveDeviceSymbol 

LetsGetOut: RET 


;If there is a symbol for this ICON 
•.button, this value should be non-zero 
;i.e. it will point to the symbol. 


;Icon starts a few lines below top of button. 


;Icon starts a few bytes inside of the edge of the button. 


SetllPDeviceD iagSymbol: 

MOV DI, [BX].ICONRightlmagePtr ;If there Is a symbol for this ICON 

OR DI, DI ;button, this value should be non-zero 

JZ GetOut ;i.e. it will point to the symbol. 

MOV AX, displayWidthlnBytes 

; XOR DX, DX 

MOV SI, vertlconOffsetlnButton 

MUL SI 

MOV SI. [BX].ICONOffset 

ADD SI, AX 

ADD SI, rightlconOffsetlnButton ;Icon starts a few bytes inside of the edge of the button. 

MOV CX, 16 

MoveDiagSymbol: 

MOV AX, CS: [DI] 

MOV ES: [SI], AH 

MOV ES: [SI+1], AL 

INC DI 

INC DI 

ADD SI, displayWidthlnBytes 

LOOP MoveDiagSymbol 

GetOut: RET 

BitsToDisplayPROCs ENDP 


background pattern painting procs 


DoLlne 

PROC 

NEAR 


PUSH 

CX 


CALL 

FillLine 


POP 

CX 


; ADD 

BX. SI 


; JNC 

FinishSecondLine 


;CALL 

BumpES 

FinishSecondLine: 



CALL 

FillLine 


; ADD 

8X, SI 


: jnc 

DoLineDone 


:CALL 

BumpES 

DoLlneDone: 

RET 


DoLine 

ENDP 


FillLine 

PROC 

NEAR 

PaintLine: 

MOV 

ES:[BX], AX 


INC 

BX 


INC 

BX 


JNZ 

LoopFI11 Line 

;Move ES into 

the next 

block of 64kb 

BumpES: 

PUSH 

AX 


MOV 

AX, ES 


ADD 

AX, crossover64KbBa 


MOV 

ES, AX 


POP 

AX 

LoopFillLine: 

LOOP 

RET 

PaintLine 

FillLine 

ENDP 



:leave loop counter on stack 
;paint one line 


;watch out for crossing 64kb boundary 

ipaint the second line 
;point to the next line 

;watch out for crossing 64kb boundary 


;paint a word 

;point to the next word 


;Save pattern 

;Change segment register to point 
nk ; into next 64K 

;Recover pattern 


GetMouseCoords PROC NEAR 

ES points into KB’s IORegion. 

Returns mousex and mouseY byteswapped in AX and BX 
ASSUME ES: KeyBoardAndMouselOR 
GetMouseX: MOV AX, mouseX 

XCHG AH, AL 

MOV BX, mouseY 

XCHG BH, BL 


;Get;MouseCoord$ ENDP 
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ASSUME DS:NOTHING, ES:NOTHING 


-- Ethernet chip initialization: 

- Assume parameter locations upon entry into System procedure 

- gre as follows: 


DS:[DI] points to an Ethernet I0C8 

DS:[BX] points to a condition variable 

AL contains handler ID for calling task 

AH contains broadcast disable & other framing parameters 


Upon exiting this procedure the following will be true: 


Etherlnitialize PROC NEAR 


PUSH ES 


SetUpReset: 


MOV DH, iocbReset SHL 4 

CALL InitEtherlOCB 

CALL ExecuteCommand 

JZ i82586InitError 


SetUpConfigure: MOV 
CALL 
MOV 
PUSH 
LEA 
MOV 
CLD 

SetUpConfigureLoop: 

MOVS 

LOOP 

POP 

MOV 

CALL 

JZ 


DH. (iocbCommand SHL 4)+-acConf igure 
InitEtherlOCB 

SI, OFFSET configureParms 
DI 

DI. [DI].iocbVariant ;ES already set by InitEtherlOCB 
CX, configureParmsSize 


BYTE PTR ES:[DI] . BYTE PTR CS:[SI] 
SetUpConfigureLoop 
DI 

ES:[DI].iocbVariant[8], AH 

ExecuteCommand 

i82588InitError 


SetUpIndAddr: MOV 

CALL 
PUSH 
XOR 
MOV 
MOV 
PUSH 

FirstSetHostProm: 

IN 

MOV 

INC 

INC 

INC 

LOOP 

POP 

POP 

CALL 

JZ 


DH, (iocbCommand SHL 4)>aclndAddr 

InitEtherlOCB 

BX 

BX, BX 

CX, addrSize 
DX, ReadHostProm 
AX 

AL. DX 

[DI].IocbVariant.cmdParms.indAddr[BX], AL 

BX 

DX 

DX 

FirstSetHostProm 

AX 

BX 

ExecuteCommand 

i82586InitError 


ReceiveFrames: MOV DH, iocbStartRU SHL 4 

CALL InitEtherlOCB 

CALL ExecuteCommand ;for startRU, always returns iocbOkay=TRUE 


i82586InitError: 


POP 

IRET 


ES 


Etherlnitialize ENDP 


ExecuteCommand 


PROC NEAR 

MOV [DI].iocbCondition.handlerlD, AL 

MOV [DI].iocbCondition.conditionPtr, BX 

OR [DI].iocbCondition.conditionPtr. nonNilPtr 

MOV CH, IOPIORegionOpieAddress 

MOV CL, AL 

PUSH AX 

%EstablIshHandlerAccess (EthernetHandlerlD) 

ASSUME ES:EthernetlOR 

MOV etherOutQueue.queueNext.OpieAddressLow, DI 

MOV etherOutQueue.queueNext.OpieAddressHigh, CX 

PUSH DI 

PUSH BX 

“/.NotifyHandlerCondi tion ( EthernetHandl erlD .OFFSET etherCmdAvai 1) 
POP BX 

PUSH BX 

%WaitForCondition (BX.noTimeout) 

POP BX 

POP DI 

POP AX 

TEST [DI].iocbStatus, MASK iocbOkay 
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ExecuteCommand 

InltEfcherlOCB 


InitEtherlOCB 


; Can this to 
; On Entry, AX 
DisplayMPCode 


DisplayMPCode 

IOPEInROM 
. ************** 


RET 


ENDP 


PROC 

NEAR 

PUSH 

AX 

XOR 

AL, AL 

MOV 

CX, DS 

MOV 

ES, CX 

MOV 

CX, SIZE IOC8 

PUSH 

DI 

CLD 


REP 

STOSB 

POP 

DI 

MOV 

[DI],locbType, DH 

POP 

AX 

RET 


ENDP 


ASSUME 

ES:NOTHING 


put a number into the curser as an MP code, 
contains number to be displayed. 

PROC 

PUSH ES 

PUSHA 

PUSH AX :EstablishHandlerAccess smashes this register 

%Establ1shHandlerAccess (MaintPanelHandlerlD) 

POP AX 

ASSUME £S:MaintPanelIOR 
MOV maintPanelCode, AX 

%NotifyHandlerCond1tlon (MaintPanelHandlerlD,OFFSET maintPanelChanged) 

%WaitForSystem 
POPA 

POP ES 

RET 

ENDP 


ENDS 


END 
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4-Sep-85 

17:36:42 

;mp codes 

JPM 


3-Aug-85 

10:35:55 

;Change EEPDefs.asm to ROMEEP.asm. 

J PM 


25-Jul-85 

12:56:27 

;Fix bug in DoDiskOperatlon (shouldn't use ES). 

JPM 


22-Jul-85 

13:57:39 

;Change lOPEInROM alignment to WORD, fix bugs. 

JPM 


18-Jul-85 

8:30:17 

;Opie redesign conversion. 

JMM 


9-Jul-85 

20:17:58 

;Upgraded to new Disk handler. 

JMM 


19-Jun-85 

17:10:06 

;Upgraded to new IOPLRAM.asm 

JPM 


17-Jun-85 

9:07:30 

;ATign bootloaded code on page boundary (for disk DMA) 

JMM 


4-Apr-85 

20:23:06 

;M1sc. edit. 

DEG 


19-Jan-85 

21:06:55 

;First release. 

JMM 


30-Nov-84 

13:44:00 

;First release. 


NAME. ROMDskBt 


SNOL.IST 
SINCLUDE 
$INCLUDE 
$INCLUDE 
SINCLUDE 
$INCLUDE 
SINCLUDE 

SLIST 

(HardDefs.asm) 

(IOPDefs.asm) 

(lOPMacro.asm) 

(ROMBDefs.asm) 

(ROMEEP.asm) 

(DsklOFce.def) 

EXTRN 


BootStrapHandlerlD: ABS 

EXTRN 


DiskHandlerlD: ABS 

EXTRN 


Disp1ayMPCode: NEAR 

;DiskAddress 


STRUC iCopied from [Iris]<WMicro>Dove>DskHdFce.def 

: diskCyl1nder 

DW 

? 

;diskSector 

DB 

? 

;diskHead 

DB 

? 

;DiskAddress 


ENDS 




IOPELocaIRAM 

SEGMENT AT 0 

EXTRN 

opieReentry: DWORD 

EXTRN 

bootType: BYTE 

EXTRN 

bootRetryCount: WORD 

EXTRN 

startOfBootBufferSpace: WORD 

EXTRN 

endOfBootBufferSpace: WORD 

EXTRN 

HandlerlnitProcTable: DWORD 

IOPELocalRAM 

ENDS 




; f rom IORRQMBt.asm: 


BootStrapIQR SEGMENT COMMON 


EXTRN 

EXTRN 

EXTRN 


bootStrapTask: TaskContextBlock 
bootOevicelORSpace: OiskBootContext 
jumpTable: BootJumpTable 


BootStrapIQR ENDS 


; from lORdisk.asm: 


DisklOR SEGMENT COMMON 

EXTRN diskFCB: DiskFCBRecord 

DisklOR ENDS 

;from STKDisk.asm: 


DiskSTK 


SEGMENT COMMON 
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EXTRN 


EndOfOiskStackSeg: WORD 
ENDS 


DiskSTK 




IOPEInROM SEGMENT WORD PUBLIC 

ASSUME CS:IOPEInROM 
ASSUME DS:BootStrapIOR 

;from ROMBoot.asm: 


PUBLIC DIskBootStrap 


-- Disk Bootstrap: 

-- This module reads in the first page of DisklnitialDove.db into 

- jgp local RAM and jumps to it. That is all it does other than 

- handling errors encounterd during the attempt to read in the 

- page. 


Upon exiting this module the following will be true: 


DiskBootStrap PROC 

StartDiskBoot: MOV AX, IOPELocalRAM 

MOV ES, AX 

ASSUME ES:IOPELocalRAM 

%CalIHandlerlnitProc (DiskHandlerlD) 

%WaitForSystem :Give disk a chance to initialize 

MOV WORD PTR bootDevIcelORSpace.disklOCBDone, Null ; Initialize condition 

; The first thing that gets done is the IOCB less the Disk Operation Block (DOB) portion is zeroed out. 


ZeroIOCBLoop: 


MOV DI, OFFSET bootDevicelORSpace.diskBootIOCB 

MOV CX. (SIZE DisklOCBRecord - SIZE DiskD08) / 2 

XOR AX, AX 

MOV WORD PTR [DI], AX 

ADD DI, 2 

LOOP ZeroIOCBLoop 


The next thing to do is to copy the image of the Initial DOB to the real 
space for the DOB in the IOCB. 


CopyLoop: 


PUSH 

ES 




MOV 

AX, DS 




MOV 

ES. AX 




ASSUME 

ES:NOTHING 




MOV 

SI, OFFSET DIsklnitialDOB 




MOV 

DI, OFFSET bootDevicelORSpace.diskBootlOCB diskOperationBlock 



PUSH 

DI 

Save the offset to the DOB on 

the 

stack for now. 

MOV 

CX, (SIZE DiskDOB / 2) 




MOVS 

WORD PTR ES:[DI], CS:[SI] 

passed on to the handler. 



LOOP 

CopyLoop 

can't use REP MOVS w/seg override 

: might get interrupted 

POP 

DI 

Fetch the offset to the DOB from 

the stack. 

steps page aligns the buffer to be used to 

read in the first record from 

the 

disk. 

POP 

ES 

Booting uses IOP local RAM 



ASSUME 

ES:IOPELocalRAM 

for all its work. 



MOV 

DX, DiskSTK 

The first record of 



SHL 

DX, Nibble 

DisklnitialDove.db goes 



ADD 

DX, OFFSET EndOfDiskStackSeg 

after the disk stack segment. 



ADD 

DX, pageSizelnBytes-l 

The location to jump to 



AND 

DX, N0T(pageS1zeInBytes-t) 

must be at a page 



MOV 

startOfBootBufferSpace, DX 

boundary. 



MOV 

bootDevicelORSpace.diskBootIOCB.dlskDataPtrLow, DX 



MOV 

CH, IOPLogicalQpieAddress 




MOV 

CL, 0 




MOV 

bootDevicelORSpace.diskBootIOCB.diskDataPtrHigh, CX 



SHR 

DX. Nibble 

Calculate the CS value of 



MOV 

jumpTable.iopEntry, nullOffset 

the loaded code’s 



MOV 

jumpTable.iopEntryCS, DX 

entry point. 
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MOV 

DX, DisklOR 

jLirait the size 

SHL 

DX, Nibble 

;of the boot 

MOV 

endOfBootBufferSpace, DX 

;area. 


: the next instructions set up the disk handler's TOP client condition 
; to point to the first word of boot IQR space (overlays first word of IOCB) 

PUSH ES 
MOV AX, DisklOR 
MOV ES, AX 
ASSUME ES:DisklOR 

MOV diskFCB.rdO.disklOPClIentCondition.handlerlD, LOW BootStrapHandlerlO 

MOV diskFCB.rdO.disklOPClientCondition.conditionPtr, OFFSET bootDevicelORSpace.disklOCBDone+nonNi1Ptr 
MOV diskFCB.rdO,disklOPClientCondition.clientMask, 0 
POP ES 

ASSUME ES:IOPELocalRAM 

ResetOiskHeads: 

MOV bootDevicelORSpace.diskBootlOCB.diskPageCount, 1 
MOV [DI].diskOperation, RecalibrateDisk 

MOV bootDevicelORSpace.dlskBootlOCB.diskOataXferDIrecti on, noDataOp 

; display mp code that initial is ready to start fetching 
PUSH AX 

MOV AX, mpFetchlnitial 

CALL DisplayMPCode 

POP AX 

CALL DoDiskOperation 

JNC DiskReadLabelAndData 

DEC bootRetryCount 

JZ FatalDiskBootError 

JMP ResetOiskHeads 

DiskReadLabelAndData: 

MOV bootDevicelORSpace.dlskBootlOCB.diskPageCount, 1 
MOV [DI].diskOperation, ReadDiskLabelAndData 
MOV bootDevicelORSpace.dlskBootlOCB.diskDataXferDirection, read 

CALL DoDiskOperation 

JNC GoToRAM 

DEC bootRetryCount 

JZ FatalDiskBootError 

JMP DiskReadLabelAndData 


JMP DWORD PTR jumpTable.iopEntry 

MOV AX, mplnitialError 

CALL Disp1ayMPCode 

%Jam (BootStrapHandlerlD.OFFSET bootStrapTask) 

%WaitForSystem ; never returns! 


ENDP 


GoToRAM: 

FatalDiskBootError: 

DiskBootStrap 


-- Disk Operations: 

- This procedure after some initialization notifies the disk 

- handler to perform the required operation. 


Upon exiting this procedure the following will be true: 


CARRY flag is set on error and reset on success 


DoDlskOperation PROC NEAR 

DoOiskOperationEntry: 


The next block of code (re-)initializes some fields within the IOCB. 

MOV AL. FALSE 

MOV bootDevicelORSpace.dlskBootlOCB.disklnProgress. AL 

MOV bootDevicelORSpace.diskBootlOCB.diskComplete, AL 

MOV bootDevicelORSpace.diskBootlOCB.diskOperationBlockError, 

MOV bootDevicelORSpace.diskBootlOCB.controllerErrorType. AL 

MOV bootDevicelORSpace.diSkBootlOCB.dmaErrorType. AL 

MOV bootDevicelORSpace.diskBootlOCB.diskError, AL 

XOR AX, AX 


AL 
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MOV [01J.diskHeaderError, AX 

MOV [DI].diskLabelError, AX 

MOV [DI].diskData£rror, AX 

MOV [DI].diskLastError, AX 

MOV [DI].diskMinusSectorCount, -1 


These next few lines of code setup the address of the Input/Output Context Block (IOCB) that is to be used to read the 
initial record from the DoveDisklnitial.db file. First CX:DX will be setup with the segment and offset to the space for 
the IOCB. Next the address is back converted to an OPIE IOP logical address. And finally the address is enqueued for the 
rigid disk handler. 

MOV OX, OFFSET bootDevicelORSpace.diskBootlOCB 

MOV CH. IOPIORegionOpieAddress 

MOV CL, LOW BootStrapHandlerlD 

PUSH ES 

MOV AX, DisklOR 

MOV ES, AX 

ASSUME ES:D1sklOR 

MOV diskFCB.rdO.disklOPNextHIgh, CX 
MOV diskFCB.rdO.disklOPNextLow, DX 
MOV diskFCB.diskStartHandlerForlOP. TRUE 
POP ES 

ASSUME ES;IOPELocalRAM 
PUSH DI 


Everything is now setup to carry out the disk operation. The rigid disk 
handler is notified that it has work to do and then this disk booting task falls 
asleep waiting for the disk code to complete. 

%NotifyHandlerCondition (DiskHandlerlD.OFFSET diskFCB.diskConditionWork) 
%WaitForCondition (OFFSET bootDevicelORSpace,noTimeout) 


; Upon completion check to see if there has been an error or not. If an error 
; occured or if the handler is not in its normal state then go through the error 
; exit path which attempts to get the handler back to a valid state. 

OperationComplete: 

POP DI 

TEST bootDevicelORSpace.dIskBootlOCB.diskError. TRUE 

JNZ ErrorDoDiskOperationExit 

CLC 

RET 

ErrorDoDiskOperationExit: 

STC 

RET 


OoDiskOperation ENDP 


•Disk 


EPROM Boot Data: 


: As far as the IOP is concerned the constants in this region are byte-swapped. 

; Any word quantity assigned must be byte-swapped. 

; The fields should be accessed through (disklOCB).diskOperationBlock.(mumble) 

; where (mumble) is a field within the DiskDOB STRUCture in DskHdFce.def . 

DisklnitialDOB: ;Actually this is of type DiskDOB (DiskOperationBlock) 


DD 

0 

;the first four bytes are for the ECC syndrome 

DW 

-1 

;the two complement of the number of sectors in transfer 

DB 

16 

;number of sectors per track. 

DB 

0 


DB 

4 

:heads per cylinder 

DB 

0 


DB 

32h 

:132h = 306d number of cylinders per drive plus one 

DB 

1 


DB 

0 

;sectors are numbered 0-15 

: Above 

five 

byte values should be gotten from EEPROM but since we are 

;only 

reading one record it does not matter unless the RAM code uses 

;the values 

passed here. - jmm :85-07-08. 

DB 

0 


DW 

-1 

;cylinder where reduced write begins (-1 if not used) 

DB 

80h 

;0080h - 128 cylinder where precompensation begins 

DB 

0 


DB 

OFFH 

1 ;write end count = OFFH 

DB 

0 


DW 

0 

•.header error field 

DW 

0 

;label error field 

DW 

0 

;data error field 

DW 

0 

;last error field 

DW 

-1 

;current cylinder 

DB 

1 

: 1 = CRC, 0 = ECC 

DB 

0 


DiskAddress 

<0,0,1> ;Location of DisklnitialDove.db 

DW 

0 


DW 

0 


DB 

0 

;DiskCtlrStatusRec 

DB 

0 

;DiskDriveStatusRec 

DB 

0 

:restore operation 

DB 

0 


DW 

0 

;tracks to format count 2's complement 
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DB 


(SIZE DIskLabelImage) OUP (0) ;end of DOB image/template 


IOPEInROM ENDS 


********************* 


END 
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;Copyright (C) 1984, 1985 by Xerox Corporation. All rights reserved. 


-- stored as [Idun]<WMicro>Dove>ROMEEP.asm 
-- created on 14-Feb-84 11:13:22 

-- This file is intended to contain ROM-resident portion of EEProm constants. 

-- last edited by: 

JPM 2-Aug-85 17:20:34 .-Make eePromLowMem and eePromH ighMem ROM-resident (display handler uses them). 

KEK 31-Jul-85 16:32:25 :created ROMEEP.asm from orig EEPDefs.asm 

JPM 14-Nov-84 14:52:53 :Updated for new layout. 

JPM 12-0ct-84 16:11:44 :Updated for new layout. 

VXS ie-Aug-84 11:04:01 :made EEPromSegment COMMON. 

VXS 8-Aug-84 15:43:40 :Made tempEEPromlmage so we 

;know where this thing is. (fixes bug where if wordsInEEProm 
;wasn't on even 4 word boundary, would be overlap) 

JPM 19-Jul-84 11:04:57 :Added eePromLockMode. 

VXS 11-Jul-84 16:28:56 :Creation. See lOPDefs.asm for earlier history. 


;Definitions for ROM-used offsets within EEProm: 

:(only the ROM-resident defs are contained here in uncommented-out form) 

;(for actual RAM and BadPage contents, see latest RAMEEP,asm and BadPage.asm) 

eePromROMVersion EQU ROMSegment+wordEEPromOffset+O 

eePromRAMVersion EQU ROMSegment+wordEEPromOffset+2 

eePromBadPageVersion EQU ROMSegment+word£EPromOffset+4 

eePromBooting EQU ROMSegment+wordEEPromOffset+6 

; [0 .. 3] = default boot device type 

; [4--4] = with icons or without icons 

; [5..5] = rigid booting allowed 

; [6..6] = floppy booting allowed 

: [7..7] = ethernet booting allowed 

; [8..8] = rs-232-c booting allowed 

: [9..15] = spare 

eePromOlspType EQU ROMSegment+byteEEPromOff set+8 

; [0..0] = 0=no display present, l=display present 

; [1..1] = 0=black and white display, 1= color display 

; [2, .6] = spare 

; [7-•?] = 0 = bitmap display type, l = non-bitmap display type 


eePromXAlign 
eePromYAl ign 

EQU 

EQU 

ROMSegment+byteEEPromOff set+9 
ROMSegment+byteEEPromOff set+10 

eePromKBType 

EQU 

ROMSegment+byteEEPromOffset+11 

eePromRigidSctPerTrk 
eePromRigidHdPerCyl 
eePromRig idCylCt 
eePromRigidRWC 
eePromRigidPCC 
eePromRigidType 

EQU 

EQU 

EQU 

EQU 

EQU 

EQU 

ROMSegment+byteEEPromOffset+12 
ROMSegment+byteEEPromOff set+13 
ROMSegment+wordEEPromOffset+14 
ROMSegment+wordEEPromOffset+16 
ROMSegment+wordEEPromOff set+18 
ROMSegment+byteEEPromOff set+20 

eePromSparel 

EQU 

ROMSegment+byteEEPromOff set+21 

eePromLowMem 
eePromHighMem 

EQU 

EQU 

ROMSegment+wordEEPromOffset+22 
ROMSegment+byteEEPromOffset+24 

eePromF1oppy 

EQU 

ROMSegment+wordEEPromOff set+42 


;Definitions for checksum offsets within EEProm: 

eePromChecksum EQU ROMSegment+wordEEProtnOf f set+124 

eePromlnvChecksum EQU ROMSegment+wordEEPromOffset+126 


Definitions for RAM-used offsets within EEProm: 

(these are included in comment form just to be complete initially) 

(for actual RAM and BadPage contents, see latest RAMEEP.asm and BadPage.asm) 

eePromMemSize EQU RAMSegment+byteEEPromOffset+25 

[0..3] = encoded VM size (in increments of 64 map pages) 

0 -> none 

1 => 64 VM map pages 

2 => 128 VM map pages 

3 => 256 VM map pages 

[4..7] = encoded control store sizes (in increments of 4K pages) 

0 => none 

1 => 4K control store 

2 = > 8K control store 

eePromHardwareBuild EQU RAMSegment+byteEEPromOffset+26 

0 => ?none 

1 => B0/B1 

2 => B2 

3-255 => spare incremental encodings 

eePromMisc EQU RAMSegment+byteEEPromOffset+27 

[0. . 0] = Default boot type bit2 (with or without diagnostics) 

[1..1] = Default diagnostic boot type bit (short or long) 
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; [2..7] = spare 

; eePromRS232DCEtype EQU RAMSegment +byteE£PromOffset+28 

;eePromRS232DCEattr EQU RAMSegment+byteEEPromOffset+29 

; eePromRS2320TEtype EQU RAMSegment+byteEEPromOf fset+30 

; eePromRS2320TEattr EQU RAMSegment+byteEEPromOffset+31 

;eePromPCEMemSize EQU RAMSegment+wordEEPromOf f set+32 

;eePromPCEConfig EQU RAMSegment+wordEEPromOf fset+34 

;eePromOptionl EQU RAMSegment+wordEEPromOffset+36 

;eePromOpt ion2 EQU RAMSegment+wordEEPromOffset+38 

;eePromOption3 EQU RAMSegment+wordEEPromOff set+40 

;th1s is actually defined in the ROM section above. 
;eePromFloppy EQU ROMSegment+wordEEPromOf fset+42 


;eePromSpare2 

EQU 

;eePromSpare3 

EQU 

:eePromSpare4 

EQU 

;eePromSpareS 

EQU 

:eePromSpare6 

EQU 

;eePromSpare7 

EQU 

:eePromSpare8 

EQU 

:eePromSpare9 

EQU 

;eePromSparelO 

EQU 

;eePromSparel1 

EQU 

;eePromSparel2 

EQU 

:eePromSparel3 

EQU 

:eePromSparel4 

EQU 

;eePromSparel5 

EQU 

;eePromSparel6 

EQU 

;eePromSparel7 

EQU 

;eePromSparel8 

EQU 

;eePromSparel9 

EQU 

;eePromSpare20 

EQU 

:eePromSpare21 

EQU 

;eePromSpare22 

EQU 

;eePromSpare23 

EQU 

;eePromSpare24 

EQU 

;eePromSpare25 

EQU 


RAMSegment+byteEEPromOf fset+44 
RAMSegment+byteEEPromOffset+45 
RAMSegment +byte£EPromOffset+46 
RAMSegment+byteEEPromOffset+47 
RAMSegment+byte£EProm0ffset+48 
RAMSegment+byteEEPromOffset+49 
RAMSegment+byteEEPromOf f set+50 
RAMSegment+byteEEPromOff set+51 
RAMSegment+byteEEPromOffset+52 
RAMSegment+byteEEPromOff set+53 
RAMSegment+byteEEPromOff set+54 
RAMSegment+byteEEPromOffset+55 
RAMSegment+byteEEPromOffset+56 
RAMSegment+byteEEPromOff set+57 
RAMSegment+byteEEPromOff set+58 
RAMSegment+byteEEPromOffset+59 
RAMSegment+byteEEPromOffset+60 
RAMSegment+byteEEPromOffset+61 
RAMSegment+byteEEPromOffset+62 
RAMSegment+byteEEPromOffset+63 
RAMSegment+byte£EPromOffset+64 
RAMSegment+byteEEPromOffset+65 
RAMSegment+byteEEPromOffset+66 
RAMSegment+byteEEPromOffset+67 


;Defin1tions for Bad Page offsets within EEProm; 

;(these are included in comment form just to be complete initially) 

;(for actual RAM and BadPage contents, see latest RAMEEP.asm and BadPage.asm) 

; eePromLastParityErrLow EQU badPageSegment+wordEEPromOffset+68 

;eePromLastParityErrHigh EQU badPageSegment+wordEEPromOff set+70 

;eePromBadPageLowl EQU badPageSegment+wordEEPromOffset+72 

;eePromBadPageHighl EQU badPageSegment+wordEEPromOffset+76 

;eeProm8adPagetow2 EQU badPageSegment+wordEEPromOffset+74 

;eePromBadPageHigh2 EQU badPageSegment+wordEEPromOffset+78 

;eePromBadPageLow3 EQU badPageSegment+wordEEPromOffset+80 

;eePromBadPageHigh3 EQU badPageSegment+wordEEPromOffset+82 

;eePromBadPageLow4 EQU badPageSegment+wordEEPromOffset+84 

; eef’romBadPageH igh4 EQU badPageSegment+wordEEPromOf fset+86 

;eePromBadPageLow5 EQU badPageSegment+wordEEPromOffset+88 

;eePromBadPageHigh5 EQU badPageSegment+wordEEPromOffset+90 

;eePromBadPageLow6 EQU badPageSegment+wordEEPromOffset+92 

;eePromBadPageHigh6 EQU badPageSegment+wordEEPromOffset+94 

;eePromBadPageLow7 EQU badPageSegment+wordEEPromOffset+96 

;eeF'romBadPageHigh7 EQU badPageSegment+wordEEPromOff set+98 

: eeF’romBadPagelow8 EQU badPageSegment+wordEEPromOff set+100 

;eeF’romBadPageHigh8 EQU badPageSegment+wordEEPromOffset+102 

:eePromBadPageLow9 EQU badPageSegment+wordEEPromOffset+104 

;eePromBadPageHigh9 EQU badPageSegment+wordEEPromOffset+106 

;eePromBadPageLowlO EQU badPageSegment+wordEEPromOffset+108 

:eePromBadPageHighlO EQU badPageSegment+wordEEPromOffset+110 

;eePromBadPageLowll EQU badPageSegment+wordEEPromOffset+112 

;eePromBadPageHighll EQU badPageSegment+wordEEPromOffset+114 

;eePromBadPageLowl2 EQU badPageSegment+wordEEPromOffset+116 

;eePromBadPageHigh12 EQU badPageSegment+wordEEPromOffset+il8 

;eePromBadPageLowl3 EQU badPageSegment+wordEEPromOffset+120 

;eePromBadPageHigh13 EQU badPageSegment+wordEEPromOffset+122 
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SMOD186 

SPAGELENGTH (72) 

$PAGEWIDTH (136) 

:Copyright (C) 1986 by Xerox Corporation, All rights reserved. 


STKBoot.asm defines stacks used by the bootstrap handler. 

stored as [Iris]<WMicro>Dove>STKBoot.asm 
created on ll-Jul-85 8:54:24 

last edited by: 

: - JPM ll-Jul-85 8:54:24 :Created. 

NAME STKBoot 

$NOLIST 

SINCLUDE (IOPStack.asm) 

SLIST 

BootStrapSTK SEGMENT COMMON 

"/.StackAl location (BootStack.) 

%StackAl1ocation (BootStrapStack,) 

BootStrapSTK ENDS 

END 
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;$MOD186 

; SPAGELENGTH (95) 

;SPAGEWIDTH (136) 

;Copyright (C) 1984, 1985 by Xerox Corporation. All rights reserved. 


-- IORegion locations for the rigid disk handler. 

stored as [Idun]<WDLion>Dove>DskHdFce . def 
-- last edited by: 


DEG 


13-Oct-84 

19:34:12 


:created by 

taking the 

hardware constants from DsklOfce.asm, 

DEG 


15-Oct 84 

14:01:01 


: introduced 

diskMapRegister 

which is currently EQUated 

to 

0. It really needs to be 

equated to 

generalMapRegister in 

the real 

system. 

DEG 


22-Oct-84 

23:58:51 


: introduced 

new definitons and redefined DOB 

according 

to 

Bob RXS 's msg of 

l9-Oct-84 

10:06 

00 POT. 




DEG 


26-0ct-84 

2:01:54 


:edited 

DEG 


2-Dec-84 

14:54:50 


:include harddefs 

DEG 


10-Dec-84 

2:03:52 


:convert to use the generalMapRegister 

DEG 


13-Dec-84 

14:25:20 


:convert back to using map register 0 for the blue-box 

DEG 


19-D6C-84 

15:03:27 


:use the generalMapRegister. 

DEG 


9-Jan-85 

15:36:57 


:change name to DskHdFce.def from DskHdFce.asm. 

DEG 


ll-Jan-85 

15:24:55 


:add definition for disk address. 

DEG 


13~Jan-85 

2:49:40 


:Add constants for FIFO problems. 

DEG 


15-Jan-85 

23:00:05 


:Fix problems in definitions. 

OEG 


18-Jan-85 

21:59:30 


:Correct a definition. 

DEG 


20-Jan-85 

9:02:45 


:Correct a definition. 

DEG 


18-Feb-85 

23:08:00 


: Make DOB 

definition 

match 

the definition 

in DisklOFaceDove.mesa. 

DEG 


28-Feb-85 

12:10:16 


:Add a new 

constant diskPageSizelnBytes. 




DEG 


27-Mar-85 

2:34:29 


:remove INCLUDES. 

DEG 


15-Apr-85 

13:49:41 


:add special error to disk status register. 


; All sizeMumbles are 

in bytes 

$NOGEN 



DiskAddress 


STRUC 

d iskCylinder 

DW 

? 

diskSector 

DB 

? 

diskHead 

DB 

? 

DiskAddress 


ENDS 


DiskLabelImage 

STRUC 




diskFiielD 

DB 

10 DUP (?) 


diskFIlePageLow DW 

? 




diskFPHighPageOAttr 

DW 

•? 



diskAttrlnAl1 Pages 

DW 

? 



diskDontCare 

DD 

? 



DiskLabelImage 

ENDS 




sizeDIskLabelImage 

EQU 

SIZE 

DiskLabelImage 


DiskDOB 

STRUC 




diskECCSyndrome 

DD 

? 



diskMinusSectorCount 

DW 

? 



diskSecPerTrack 

DB 

? 



diskZerol 

DB 

? 



diskHdsPerCyl 

DB 

? 



diskZero2 

DB 

? 



cylPerDrive 

DW 

? 



diskStartSec 

DB 

? 



d i skZero3 

DB 

? 



diskReducedWriteCyl 

DW 

? 



diskPreCompCyl 

DW 

? 



diskWriteEndCnt 

DB 

? 



diskZero4 

DB 

? 



diskHeaderError 

DW 

? 



diskLabelError 

OW 

? 



diskDataError 

DW 

? 



diskLastError 

DW 

? 



di skCurrentCyl 

DW 

? 



d iskECCFlag 

DB 

■? 



d i skZeroS 

DB 

? 



d i skHeader 

DD 

? 



diskReservedl 

DW 

? 



d iskReserved2 

DW 

? 



d iskCtlrStatus 

DB 

? 

:Actually of 

Di skCtlrStatusRec 

diskDriveStatus 

DB 

? 

;actua11y of 

Di skDriveStatusRe 

diskOperation 

DB 

? 



diskZero6 

DB 

? 



diskMinusFmtCnt 

DW 

? 
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diskLabel DB (SIZE Di skLabelImage) DUP (?) 

DiskDOB ENDS 

sizeDiskDOB EQU SIZE DiskDOB 

dobSize EQU sizeDlskDOB 

minusDOBSize EQU 0 - dobSize 


; --> disk status record definitions <-- 

DiskDrlveStatusRec RECORD dskDriveNotReady: I, dskSeekNotComplete: 1, dskUnuO; 1, dskAddrMark: 1, dskNotStoredlndxMrk: 1, 

dskNotTrackO: 1, dskNotWritefault: 1. dskLock: 1 

DiskCtlrStatusRec RECORD dskReadDataFound: 1, dskNotBDone: 1, dskFIFOEmptyAtRead: 1, dskNotSPMA3: 1, dskNotSPMAMaxCnt: 1, 

dskAlBISame; 1. dskFIFOEmpty: 1, dskFIFOFull: 1 


; disk controller's commands <-- 

DiskCommandReg RECORD crStopBit: 1, crDiagMode: l, crUnused: 2, crUnuCmd: 2, crCmd: 2 

goToIdleLoop EQU 0 

xferDOBToController EQU 1 

executeDOB EQU 2 

xferDOBFromController EQU 3 

inldleLoop EQU goToIdleLoop 


; -•-> disk controller's status <-- 

DiskStatusReg RECORD srErrorBit: 1, srDone: 1, srSpecialError: 2, srUnused: 2, srCmd: 2 

stat.usRegisterErrorBit EQU MASK srError8it 

diskRDCDone EQU MASK srDone 

noDiskSpecialError EQU 0 

diskFIFOError EQU lOh 

diskSpecialErrorO EQU 20h 

diskSpecialErrorl EQU 30h 


; --> disk DMA's status <-- 

DIskDMAReg RECORD diskDMAFIFODir: l, diskDMABbl: 1, diskDMAFIFQFulIBar: 1, diskDMAFIFOEmptyBar; 1, diskDMAFIFOBoundsBar: 1, 

diskDMAEndOfXferBar: 1, dlskDMARunStateMachBar: 1, diskDMAError8it: 1 

DiskDMAStatusMask EQU 33h 

DIskDMAIsInResetState EQU 20h 


--> Rigid Disk DMA Hardware Constants <-- 


diskDMAModeO 

EQU 

0 

diskDMAMode1 

EQU 

2 

diskDMAMode2 

EQU 

4 

diskDMAMode3 

EQU 

6 

diskDMAMode 

EQU 

di$kDMAMode3 


--> FIFO commands <-- 


fifoToMemory 

EQU 

0 

memoryToFIFO 

EQU 

-1 

noDataXfer 

EQU 

1 


--> Interesting Rigid Disk Hardware Ports <-- 


DiskReadDMAWordCount 

EQU 

0204h 

OiskReadDMAAddressWordOffset 

EQU 

02G6h 

DiskDMAAddressPage 

EQU 

0208h 

DiS kDMAAdd res sWo rdOff set 

EQU 

020Ah 

DiskWriteDMAWordCount 

EQU 

020Ch 

DiskDMADirection 

EQU 

0210h 

DiskDMAStatus 

EQU 

02 lOh 

DiskControl1erCommandRegister 

EQU 

0214h 

DiskControl1erStatusRegister 

EQU 

0214h 

DiskStartDMA 

EQU 

0216h 

DiskPresetAl 

EQU 

0212h 

DI skWr 1 te2942CR2«-CR0 

EQU 

0200h 

Di skRead2942CR2«-CR0 

EQU 

0202h 

DiskEnab1e2942Counters 

EQU 

020Eh 
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--> Disk Operations <-- 


RecalibrateDlsk 

EQU 

0 

FormatDIskT racks 

EQU 

1 

ReadDiskData 

EQU 

2 

WriteDlskData 

EQU 

3 

WriteDiskLabel AndData 

EQU 

4 

ReadD iskLabel 

EQU 

5 

ReadD i skLabelAndData 

EQU 

6 

VerifyDiskData 

EQU 

7 

; --> Disk Operations 

<-- 


QlagDiskRead 

EQU 

1 


--> Other Interesting Hardware Constants <-- 


d 1 skPcigeSizelnBytes 


EQU 

512 

diskPageSizeInWords 


EQU 

256 

ni ICondltion 

EQU 

0 


preNotifiedCondition 

EQU 

1 


nybble EQU 

4 



nybbleMask EQU 

OFh 




; In the real system diskMapRegister needs to be EQU to generalMapRegister. 
; For testing on an IOP-only system this value is set to 0. 
diskMapRegister EQU generalMapRegister 
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;$MOD186 

;$PAGEI.ENGTH (95) 

;$PAGEWIOTH (136) 

;Copyright (C) 1984, 1985 by Xerox Corporation. All rights reserved. 


- lORegion locations for the rigid disk handler, 
stored as [Idun]<WDLion>Dove>DskIOFce.def 


-- last edited 

DEG 

by 

20-Aug-84 

10:35:36 

created 

DEG 


12-Sep-84 

16:59:34 

:edited for Initial cut. 

OEG 


30-Sep-84 

22:55:49 

:edited for use SIZE operator. 

DEG 


2-Oct-84 

0:40:21 

:fixed DOB definition. 

DEG 


4-Oct-84 

16:29:13 

:fixed some constant declarations. 

DEG 


14-0ct-84 

0:11:59 

:1ntroduce new values and change definitions. 

DEG 


18-Oct-84 

4:27:25 

:introduce new values. 

DEG 


25-Oct-84 

10:01:31 

ichange disk operation constants. 

OEG 


26-Oct-84 

11:14:18 

ichange layout of a few records.. 

DEG 


10-Dec-84 

2:02:44 

: Edited for Opie 17 compatibility. 

DEG 


16-Dec-84 

23:34:50 

: Add 

comp!ementDOB 

to 

DiskDataRee RECORD so that the 

client can specify whether 

complementing 

is 

necessary or not. 

:changed name to DsklOFce.def from DsklOFce.asm 

DEG 


9-Jan-85 

15:35:20 

DEG 


13-Jan-85 

0:42:02 

:add handler states 6 & 7. 

DEG 


14-Jan-85 

2:39:20 

; add HNH for getting EEPROM data to disk handler clients 

DEG 


15-Jan-85 

23:03:30 

: remove contention In naming. 

DEG 


16-Jan-85 

10:11:32 

:place hook for testing both etchl and etch2 boards. 

DEG 


20-Jan-85 

16:37:04 

:correct some definitions of STRUCtures. 

DEG 


22-Jan-85 

4:10:12 

:added another condition variable. 

DEG 


2-Feb-85 

18:39:22 

iswitched dataPtr high and low in IOC8. 

DEG 


25-Feb-85 

18:47:55 

:use defined EEPROM indices. 

DEG 


2-Mar-85 

23:13:53 

•.size of DOB was 

in words instead 

of in bytes as 

it should have 

been. Add HNH for the LEDs to 


be used to display page count. 

DEG 4-Mar-85 1:57:23 

dIskPresentCylInder to the DiskDCBRecord so th 
cylinder information. 

DEG 8-Mar-85 1:51:57 

word quantities such that the low word appears 
DEG 27-Mar-85 2:35:02 

DEG 29~Mar-85 15:54:38 

DEG l6-Apr-85 13:43:22 

for proper synchronization between the head and 


BKI 


10-May-85 20:47:07 


t we can maintain the correct 

:Adjust double 
first. 

: remove INCLUDES. 

:convert to 0pie!19. 

;make changes to data structures 
the handler; correct a typo as well. 

:Add controllerErrorType and dmaErrorType. 


; All sizeMumbles are in bytes. 

$N0GEN 

SINCLUDE (DskHdFce.def) 

; Disk data structures 

DiskClientType: TYPE = MACHINE DEPENDENT 

(driveOMesaClient, driveOIOPClient, drivelMesaClient, drive1IOPC1ient, 
drive2MesaClient, drive2I0PClient, drive3MesaClient. drive3IOPClient) 


DiskDCBRecord 

STRUC 



diskMesaHead 

DW 

7 


diskMesaNext 

ow 

7 


diskMesaTail 

DW 

7 


diskBlockMesaQueue 

DW 

7 


disklOPHeadLow 

DW 

7 


disklOPHeadHigh 

DW 

7 


disklOPNextLow 

DW 

7 


disklOPNextHigh 

DW 

7 


disklOPTailLow 

OW 

7 


disklOPTaiIHigh 

DW 

7 


diskBlocklOPQueue 

DW 

? 


diskCurrentDriveMask 

DB 

7 


diskContmand 

DB 

? 


diskMesaClientCondition 

DB 

(SIZE 

Cl ientCondition) DUP (?) :ClientCondition 

disklOPClientCondition 

DB 

(SIZE 

Cl ientCondition) DUP (?) ;C1ientCondition 

diskCurrentlOCBLow 

DW 

7 


diskCurrentlOCBHigh 

DW 

7 


diskMisc 

DW 

7 

;word used exclusively by the Client. 

diskSpareO 

DB 

7 


diskDriveType 

DB 

7 


diskSectorsPerT rack 

DB 

7 


diskHeadsPerCylinder 

DB 

7 


diskCylindersPerDrive 

DW 

7 


diskReducedWriteCurrentCylInder 

DW 

7 

diskPreCompensationCyl inder 

DW 

7 


<> 

<> 


DiskDCBRecord ENDS 

sizeDIskDCBRecord EQU SIZE DiskDCBRecord 
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DiskFCBRecord 

STRUC 





diskTask 

OB 

SIZE 

taskContextBlock DUP (?) 

;TaskContextBlock 

diskDMATask 

DB 

SIZE 

taskContextBlock DUP (?) 

;TaskContextBlock 

diskCond111onDMAWo rk 

DB 

SIZE 

Condition DUP (?) 

;Condition 

<> 

dlskConditionDMADone 

DB 

SIZE 

Condition DUP (?) 

Condition 

<> 

dlskConditionWork 

DB 

SIZE 

Condition DUP (?) 

;Condition 

<> 

diskWorkMask 

DW 

7 

;work mask 



dlskLockMask 

DW 

7 

;1ock mask 



diskMesaCl eanupRequest 

DW 

7 




disklOPCleanupRequest 

DW 

? 




dlskHandlerStoppedForMesa 


DW ? 



diskHandlerStoppedForlOP 


DW ? 



diskHandlerStoppedForMesaCleanup 


DW ? 



diskHandlerStoppedForlOPCleanup 


DW ? 



diskStartHandlerForMesa 

DW 

7 




diskStartHandlerForlOP 

DW 

7 




dlskHandlerState 

DW 

7 




diskCurrentClient 

DB 

7 

;DiskC1IentType 



dlskCl ientsToTest 

DB 

7 

;CARDINAL[0..numDiskClientsj 


dlskNumPossibleClients 

DB 

7 




diskLastDriveMask 

DB 

7 




dlskCurrentDrivePtr 

DW 

7 

;Used by handler 

to save ptr to 

current drive 

diskStatusRegister 

DB 

7 




diskCommandReglster 

DB 

7 




dlskTaskRetryCount 

DB 

7 




d iskBadlnterruptReason 

DB 

7 




diskDMAStatusRegister 

DB 

7 




diskBadDMAInterruptReason 

DB 

7 



unexpectedDisklnterruptCount 

DW 

7 



unexpectedDlskDMAInterruptCount 

DW 

7 



rdO 

DB 

SIZE 

DiskDCBRecord DUP (?) 

;DiskDCBRecord 

<> 

rdl 

DB 

SIZE 

DiskDCBRecord DUP (?) 

;DiskDCBRecord 

<> 


o 

<> 


DiskFCBRecord 
sizeDiskFCBRecord 


ENOS 

EQU 


SIZE DiskFCBRecord 


DiskDataRec RECORD incrementOataPtr: 1, cotnpl ementDOB : I, 
dataCommandTransfer: 1, unused2: 6, commandDirection: 1 


etch2: 1, ddrunul: 2, diskllseLEDs: 1, diskHalt: 


DisklOCBRecord STRUC 


diskPrivateStuff 

DW 

35 DUP (?) 

diskDataPtrlow 

DW 

? 

diskDataPtrHIgh 

DW 

7 

diskDatalnfoRec 

DW 

7 ;actually Of 

diskPageCount 

DW 

? 

diskStopHand1erOnCompletion 

DB ? 

diskOnlyOQBFromController 

DB ? 

diskError 

DB 

7 

diskOperationB1ockError 

DB 

7 

controllerErrorType 

DB 

7 

dmaErrorType 

DB 

7 

diskComplete 

DB 

7 

disklnProgress 

DB 

7 

diskDataXferDirection 

DB 

7 

diskDMATimedOut 

DB 

7 

diskNextlow 

DW 

? 

dlskNextHigh 

DW 

7 

diskOperationBlock 

08 

SIZE DiskDOB DUP (?) 

DisklOCBRecord 

ENDS 


sizeDisklOCBRecord 

EQU 

SIZE DisklOCBRecord 


fromMesa EQU 

toMesa EQU 

0 

MASK 

commandDirection 

NILPtr 

EQU 

0 

NILOpieAddressHigh 

EQU 

nilOpieAddress * tOOh 

NlLOpieAddressLow 

EQU 

0 


mesaShortPtrOpieAddressType EQU mesaEnvBaseWord*lOOh 


type 


DiskDataRec. 


--> Handler states <-- 


normalDiskHandlerState EQU 
diskControllerNotldling EQU 
badDisklnterrupt EQU 
badDiskDMAInterrupt EQU 
; diskDMAError EQU 
resettingDiskDMATask EQU 
initlalStartDiskDMATask EQU 
resettingHandler EQU 


0 

1 

2 

3 

4 

5 

6 
-1 
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diskControllerError 

EQU 

1 

diskDMAError 

EQU 

1 

disklnterruptTimeout 

EQU 

2 

controllerNotin Id!eLoop 

EQU 

3 

fifoNotEmpty 

EQU 

3 


DiskClientType 

RECORD dctUnused: 5, 

dlskClientMask 

EQU 

MASK 

diskDriveMask 

EQU 

MASK 

diskMesaClient 

EQU 

0 

disklOPClient 

EQU 

2 

diskOriveRDO 

EQU 

0 

diskDriveRDl 

EQU 

4 * 1 

diskOriveRD2 

EQU 

4 * 2 

diskDriveR03 

EQU 

4 * 3 


diskDrive: 2, diskCHent: 1, dctZero: 1 

diskClient 

diskDrive 


; riveOMesaCllent 

EQU 

driveOIOPCIient 

EQU 

drivelMesaClient 

EQU 

drivellOPClient 

EQU 

drive2MesaClient 

EQU 

dr ive2IOPClient 

EQU 

dr1ve3MesaClient 

EQU 

drive3IOPClient 

EQU 


diskMesaCl ient +■ diskOriveRDO 
disklOPClient + diskDriveRDO 
diskMesaClient * diskDriveRDl 
disklOPClient +■ diskDriveRDl 
diskMesaCl ient +• diskDriveRD2 
dlsklOPClient + diskDriveRD2 
di skMesaCl ient +■ diskDriveRD3 
disklOPCl ient +■ diskDriveRD3 


lastDriveClient 


EQU driveOIOPCIient 


Indexes for EEPROM 


eeOiskTypelndex 


EQU 

eePromRigidType 

eeOiskSectorsPerT rackIndex 

EQU 

eePromRigidSctPerTrk 

eeDiskHeadsPerCy1inderIndex 

EQU 

eePromRigidHdPerCy 1 

eeDiskCylinderCountlndex 


EQU 

eePromRigidCylCt 

eeDiskRedueedWriteCylinderlndex 

EQU 

eePromRigidRWC 

eeDiskPreCompCylinderlndex 

EQU 

eePromRigidPCC 

; Miscellany 




numSupportedDiskDrives 

EQU 

1 


numPossibleDiskDrives 

EQU 

2 


maxMumOfDiskDrives 

EQU 

4 


numDiskClientsPerDrive 

EQU 

2 


numDiskClients 

EQU 

numSupportedDiskDrives * numDiskClientsPerDrive 

numPossibleDiskClients 

EQU 

numPossibleDiskDrives * numOiskClientsPerDrive 

defaultlnitialDiskCylinder 

EQU 

-L 

start EQU 

0 



read EQU 

0 



write EQU 

l 



execute EQU 

2 



noDataOp EQU 

3 



wordSize EQU 

2 



noWatchDogTimeOuts 

EQU 

255 


tenMil1iseconds 

EQU 

10 


UnexpectedInterrupt 

EQU 

1 



DsklOFce.def 


IO-May-85 20:53:41 PDT 








REM DiskBoot.bat 

REM Copyright (C) 1987 by Xerox Corporation. All rights reserved. 

BREAK ON 

REM. 

REM Build DiskBoot.1oc! 

REM MUST RUN RAMBOOT.BAT BEFORE THIS! 

REM- 

XFILE RET DskBDefs.asm -o 
XFILE RET DskHdFce.def -o 
XFILE RET DsklOFce,def -o 
XFILE RET RAMBDefs.asm -0 
XFILE RET ROMBOefs.asm -o 
XFILE RET RAMDskBt.asm -o 
XFILE RET RAMBoot.1nk -Q 
XFILE RET IORDisk.obj -o 

CRLFTool /If DskBDefs.asm 
OEL DskBDefs.bak 
CRLFTool /If DskHdFce.def 
DEL DskHdFce.bak 
CRLFTool /If DsklOFce.def 
DEL DsklOFce.bak 
CRLFTool /If RAMBDefS.asm 
DEL RAMBOefs.bak 
CRLFTool /If ROMBDefs.asm 
DEL ROMBDefs.bak 
CRLFTool /If RAMDskBt.asm 
DEL RAMDsk8t.bak 

RUN ASMS6 RAMDskBt.asm DEBUG > RAMDskBt.log 

TYPE RAMDskBt.log 

PAUSE 

RUN LINK86 RAMDskBt.obj, IORDisk.obj, RAMBoot.Ink to DiskBoot.lnk 
REM This will cause an unresoved external warning on TransmitFrame. 

REM Ignore it. 

RUN LOG86 DiskBoot.lnk to DiskBoot.loc PC(PURGE) ADDRESSES (SEGMENTS(IOPEInRAM(OAOOH))) 

XFILE STORE DiskBoot.loc -o 
XFILE STORE Di$kBoot.mp2 -o 
XFILE STORE DiskBoot.lnk -o 
XFILE STORE RAMDskBt,obj ~o 

REM 

REM ****** Then do the following in XDE ****** 

REM 

REM MakelnitialMIcroBoot DisklnitialDove ,db «■ DiskBoot.loc 

REM 

REM 

REM fini 
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REM Initial.bat 

REM Copyright (C) 198? by Xerox Corporation. All rights reserved. 

BREAK ON 

REM - 

REM Build FIpyBoot/DiskBoot/EthrBoot.loc! 

REM MUST RUN RAM800T.BAT BEFORE THIS! 

REM -- 

REM This batch file is the concatenation of D1skBoot.bat, EthrBoot.bat. and FlpyBoot.bat. 


XFILE 

RET 

DsplDefs.asm 

-0 

XFILE 

RET 

FIopFace.asm 

-o 

XFILE 

RET 

ROMBDefs.asm 

-o 

XFILE 

RET 

RAMBDefs.asm 

-o 

XFILE 

RET 

FlpBDefs.asm 

-o 

XFILE 

RET 

RAMFlpBt.asm 

-o 

XFILE 

RET 

DskBDefs.asm 

-o 

XFILE 

RET 

DskHdFce.def 

-o 

XFILE 

RET 

DsklOFce.def 

-o 

XFILE 

RET 

RAMDskBt.asm 

-o 

XFILE 

RET 

RAMEthBt.asm 

-o 

XFILE 

RET 

EthlOFce.asm 

-o 

XFILE 

RET 

EthHdFce.asm 

-o 

XFILE 

RET 

EthBDefs.asm 

-o 

XFILE 

RET 

IORFlop.obj - 

-o 

XFILE 

RET 

IORDisk.obj - 

-o 

XFILE 

RET 

lOREther,obj 

-o 

XFILE 

RET 

RAMBoot.Ink - 

-o 


CRLFTool /If DsplDefs.asm 
DEL DspIDefs.bak 
CRLFTool /If FlopFace.asm 
DEL FlopFace.bak 
CRLFTool /If ROMBDefs.asm 
DEL ROMBDefS.bak 
CRLFTool /If RAMBDefs.asm 
DEL RAMBDefs.bak 
CRLFTool /If FlpBDefs.asm 
DEL FIpBDefs.bak 
CRLFTool /If RAMFlpBt.asm 
DEL RAMFlpBt.bak 
CRLFTool /If DskBDefs.asm 
DEL DskBDefs.bak 
CRLFTool /If DskHdFce.def 
DEL DskHdFce.bak 
CRLFTool /If DsklOFce.def 
DEL DsklOFce.bak 
CRLFTool /If RAMDskBt.asm 
DEL RAMDskBt.bak 
CRLFTool /If RAMEthBt.asm 
DEL RAMEthBt.bak 
CRLFTool /If EthlOFce.asm 
OEL EthlOFce.bak 
CRLFTool /If EthHdFce,asm 
DEL EthHdFce.bak 
CRLFTool /If EthBDefs.asm 
DEL EthBDefs.bak 


RUN ASM86 RAMFlpBt.asm DEBUG > RAMFlp8t.log 

RUN ASM86 RAMDskBt.asm DEBUG > RAMDskBt.log 

RUN ASM86 RAMEthBt.asm DEBUG > RAMEthBt.log 

TYPE RAMFlpBt.1og 

TYPE RAMDskBt.log 

TYPE RAMEthBt.log 

PAUSE 

RUN LINK86 RAMFlpBt.obj, IORFlop.obj, RAMBoot.Ink to FlpyBoot.lnk 
RUN LINK86 RAMDskBt.obj, IORDisk.obj, RAMBoot.Ink to DiskBoot.lnk 
RUN LINK86 RAMEthBt.obj, lOREther.obj,RAMBoot.1 ok to EthrBoot.lnk 
REM This will cause an unresoved external warning on TransmitFrame. 

REM Ignore it. 

RUN LOC8G FlpyBoot.lnk to FlpyBoot.loc PC(PURGE) ADDRESSES (SEGMENTS(I0PEInRAM(08F0H))) 

RUN LOC86 DiskBoot.lnk to DiskBoot.loc PC(PURGE) ADDRESSES (SEGMENTS(IOPEInRAM(OAOOH))) 

RUN LOC86 EthrBoot.lnk to EthrBoot.loc PC(PURGE) ADDRESSES (SEGMENTS (I0PEInRAM(0980H))) 


XFILE 

XFILE 

XFILE 

XFILE 

XFILE 

XFILE 

XFILE 

XFILE 

XFILE 

XFILE 

XFILE 

XFILE 


STORE FlpyBoot.loc -Q 
STORE DiskBoot.loc -o 
STORE EthrBoot.loc -0 
STORE FlpyBoot.lnk -o 
STORE DiskBoot.lnk -o 
STORE EthrBoot.lnk -o 
STORE FlpyBoot.mp2 -o 
STORE D1skBoot.mp2 -o 
STORE EthrBoot.mp2 -o 
STORE RAMFIp8t.obj -0 
STORE RAMDskBt.obj -o 
STORE RAMEthBt.Obj -0 


REM 

REM ****** Then do the following in XDE ****** 

REM 

REM MakelnitialMicroBoot FI oppylni tialOove . db *- FlpyBoot.loc 
REM MakelnitialMicroBoot DisklnitialDove.db *- DiskBoot.loc 
REM Makelni tialMicroBoot Etherlni tialDove . db *- EthrBoot.loc 
REM 
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REM 

REM Finn 
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REM RAMBoot.bat 

REM Copyright (C) 1987 by Xerox Corporation. All rights reserved. 
BREAK ON 


REM ----- 

REM Build RAMBoot.1nk! 


REM -■ 

XFILE 

RET 

STKBoot.Obj - 

0 

XFILE 

RET 

IORMaint.obj 

-o 

XFILE 

RET 

IOPLRAM.obj - 

0 

XFILE 

RET 

RAMBDefs.asm 

-o 

XFILE 

RET 

RamBoot.asm - 

0 

XFILE 

RET 

EthHdFce.asm 

-o 

XFILE 

RET 

HardDefs.asm 

-o 

XFILE 

RET 

IOPDefs.asm - 

0 

XFILE 

RET 

IOPMacro.asm 

-o 

XFILE 

RET 

EthBDefs.asm 

'0 

XFILE 

RET 

Handlers.asm 

-o 

XFILE 

RET 

IORRAMBt.asm 

-o 

XFILE 

RET 

CSBankDf.asm 

-o 

XFILE 

RET 

RAMEEP.asm -o 



CRLFTool /If RAMBOefs.asra 
DEL RAMBDefs.bak 
CRLFTool /If RamBoot.asm 
DEL RamBoot.bak 
CRLFTool /If EthHdFce.asm 
DEL EthHdFce,bak 
CRLFTool /If HardDefs.asm 
DEL HardDefs.bak 
CRLFTool /If IOPDefs.asm 
DEL IOPDefs.bak 
CRLFTool /If IOPMacro.asm 
DEL IOPMacro.bak 
CRLFTool /If EthBDefs.asm 
DEL EthBDefs.bak 
CRLFTool /If Hand lers.asm 
DEL Handlers.bak 
CRLFTool /If IORRAMBt.asm 
DEL IORRAMBt.bak 
CRLFTool /If CSBankDf.asm 
DEL CSBankDf.bak 
CRLFTool /If RAMEEP.asm 
DEL RAMEEP.bak 

RUN ASM86 RAMBoot.asm DEBUG > RAMBoot.log 
RUN ASM86 IORRAMBt.asm DEBUG > IORRAMBt. 1og 
TYPE RAMBoot.log 
TYPE. IORRAMBt. 1 og 
PAUSE 

RUN LINK86 RAMBoot.Obj,IOPLRAM.Obj,IORRAMBt.Obj,STKBoot.Obj,lORMaint.Obj TO RAMBoot.Ink 

XFILE STORE RAMBoot.Ink -o 
XFIL.E STORE RAMBoot.mpl -o 
XFILE STORE RAMBoot.obj -0 
XFILE STORE IORRAMBt.obj -o 

REM--- 

REM Build FlpyBoot/DiskBoot/EthrBoot.loc! 

REM- 


REM-If you don't want to run Initial.bat, type Control C 
PAUSE 

XFILE RET Initial.bat -o 

CRLFTool /If Initial.bat 
DEL Initial.bak 

Initial.bat 

REM Initial.bat depends on components rebuilt in here! 
REM fini 
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;Copyright (C) 1984, 1985 by Xerox Corporation. All rights reserved, 
:CSBankDf.asm 

;For coordinating between Ramboot.asm and Csbank.asm. 

;la$t Edited By: 

: RDH 13~Jan~86 15:17:57 :Create. 

bankConfigMask EQU 30H ;For the convenience of *InitialDov( 

: may be as small as possible. 


that it 


CSBankOf.asm 


13-Jan-86 15:21:20 PST 




;Copyright (C) 1985, 1987 by Xerox Corporation. All rights reserved. 


Definitions for the disk boot handler, 
stored as [Ir1s]<WM1cro>Dove>DskBDefs.asm 

;-- last edited by: 


-- 

JPM 

18-May~87 

8:42:53 

;Changed value of diskShapeHeadAndSector 


J PM 

4-May-87 

16:18:25 

;Added DlskShape STRUC & constants. 


JPM 

16-Jul-85 

12:50:41 

;bootDataBegins moved to RAMBDefs. 

-- 

JMM 

26-Jun-85 

16:36:59 

;Removed imbedded defs. 


JPM 

17-Jun-85 

10:33:30 

;Created from FlpBDefs.asm. 


STRUC for file descriptor 

FiloSpec STRUC 

Cyi 
HdSct 

FileSpec ENDS 


DW ? 

DW ? 


cylinder in entire word 

head in high byte, sector number in low byte 


;STRUC for dev ice-spec ific IORegion area (overlays deviceSpecificArea) 


DiskBootArea STRUC 


disklOCBDone 

DB 

SIZE(Condition) DUP (?) 

idiskBootlOCB 

DB 

156 DUP 

?) : first 70 bytes can be overlaid 

f i 1eCount 

DB 

? 



DB 

? 


f ilol 

DB 

SIZE(FileSpec) DUP (?) 

filo2 

DB 

SIZE(FileSpec) DUP (?) 

f11e3 

DB 

SIZE(F11eSpec) DUP (?) 

DiskBootArea 

ENDS 



diskBootlOCB 

EQU 

f ileCount 

STRUC for file id in 

root 

page 


DiskRootFi1elD 

STRUC 



DFIDfilelD 

DB 

10 DUP (7 

) : file ID 

DFIDfirstPg 

DB 

4 DUP (?) 

; first page 

DFIDcylinderHigh 

DB 

? 

cylinder h1gh byte 

DFIDcylinderLow 

DB 

? 

cylinder low byte 

DFIOhead 

DB 

? 

head 

DFIDsector 

DB 

? 

sector 

DiskRootFilelD 

ENDS 



STRUC for disk shape 




DiskShape 

STRUC 



DSseal 

DW 

? 

must equal diskShapeSeal 

DSversion 

DW 

? 

must equal diskShapeVersion 

DStype 

DW 

? 



DB 

? 


DSsectorsPerTrack 

DB 

? 



DB 

? 


DSheadsPerCyl inder 

DB 

? 


DScy11nderCount 

DW 

? 


DSreducedWriteCyl 

DW 

? 


DSpreCompCyl 

DW 

? 



DW 

246 DUP 

?) 

DSchecksum 

DW 

? 


DS i nvertedChecksum 

DW 

? 


DiskShape 

ENDS 



constants 




sectorSize 

EQU 

onePage 

sector size in bytes 

rootPageCylinder 

EQU 

0 

location of root page 

rootPageHeadAndSector 

EQU 

0 

is cyl. 0, head 0, sector 0 

rootPageHeaderSize 

EQU 

16 

16 bytes of header before 1st file ID 

diskShapeCylinder 

EQU 

0 

location of disk shape 

diskShapeHeadAndSector 

EQU 

14 

is cyl. 0, head 0, sector 14 

diskShapeSeai 

EQU 

9665H 

byteswapped 6596H = 62626 octal 

diskShapeVersion 

EQU 

100H 

byteswapped 1 

: -- 

END 

OskBDefs 



DskBDefs.asm 


18-May-87 8:42:55 POT 








; File: DsplDefs.asm - last edit: 

: MXT 6-Mar-86 10:57:11 

: Copyright (C) 1986 by Xerox Corporation. All rights reserved 


- stored as [Idun]<WDLion>Oove>DsplDefs.asm 
Copyright (C) 1984 by Xerox Corporation. All rights reserved. 


Last edited by: 

MXT 2-May-86 10:30:53 
MXT 10-Feb-86 19:28:06 
JPM/kek l-Sep-85 14:23:55 
ANK 10-Jan-85 12:25:45 
ANK 3-Jan-85 15:47:18 
ANK 14-Nov-84 9:00:56 
ANK 26-Sep~84 12:53:16 
ANK 13-Sep-84 10:13:43 


Changed borderOnlyMask and videoDisableMask 
Added Daisy specific I/O Addresses 

Added *chngd (flags for chngdlnfo word) (taken from B0 edits) 

Changed to use the 2nd etch IO port addresses 

Added Software Reset port 

Deleted D1splMemStrtLow and High 

Deleted MapRegistersDayBreak 

Added MapRegistersDayBreak 


;Constants used for display handler/ Maintainence panel handler synchronization 

MPCursor EQU OFFH ;Cur$orUser=FF when MP handler is setting the cursor pattern 

DisplayCursor EQU 0 ;CursorUser=0 when display handler is setting the cursor pattern 


Set up constants for I/O addresses 
DAYBREAK/DAISY ADDRESSES 


DAYBREAK ADDRESSES 


VertstoreDayBreak 

EQU 

0E80OH; 

Starting iocn of vertical control store 

HorzStoreDayBreak 

EQU 

OECOOH; 

Starting locn of horizontal control store 

Di splCntlRegDayBreak 

EQU 

0EC8OH; 

Data display control register 

BorderPatternLowDayBreak 

EQU 

0EC81H; 

Border pattern low byte 

BorderPatternHighDayBreak 

EQU 

0EC82H; 

Border pattern high byte 

CursorWordPortDayBreak 

EQU 

0EC83H; 

Word number of cursor position 

CursorOffsetPortDayBreak 

EQU 

0EC84H; 

Word offset of cursor position 

CursorLinePortLowDayBreak 

EQU 

0EC85H; 

Line number of cursor position (Low byte) 

CursorLinePortHighDayBreak 

EQU 

0EC86H; 

Line number of cursor position (High byte) 

DMCWordsPerLineQayBreak 

EQU 

0EC88H; 

DMC register that contains number of words per line 

DMCDisplStrtAddrLowDayBreak 

EQU 

0EC89H; 

DMC register that holds low byte of display mem. strt addr 

DMCDisplStrtAddrHighDayBreak 

EQU 

0EC8AH; 

DMC reg. that holds high byte of display mem. strt addr. 

DisplMemStatReglstDayBreak 

EQU 

0EC8CH 


SysMemStatReg2ndDayBreak 

EQU 

0EC8DH 


SysMemStatReg3rdDayBreak 

EQU 

0EC8EH 


SysMemStatReg4thDayBreak 

EQU 

0EC8FH 


DisplaySoftReset 

EQU 

0ED60H; 

A read from this port resets display HW 

CursorBufferPortsDayBreak 

EQU 

0ED00H; 

Cursor buffer starting locn. 


DAISY ADDRESSES -- All these I/O addresses are TBD 

Daisy A chip registers are accessed via IN/OUT instructions and their addresses are calcurate from following equation. 
0800 +■ 0100 * AID + Location 

here AID is the A chip ID: CARDINAL [0..4) 
following definitions are Location. 

in actual use. the AID should be QRed into upper byte. 

AIDO = 0800H 
AID1 = 0900H 
AID2 = 0A00H 
AID3 = 0800H 


AChipO 

EQU 

08H; 



CursorBufferReg 

EQU 

880H 

Cursor buffer starting location. 


HCursor 

EQU 

8AOH 

Cursor x-coodinate in words. 

bl5,,b 14 = Cursor Nibble Offset. bl3,,bl2 = Cu 

rsor Rotate parameter 

HBorder1 

EQU 

8A4H 

Starting point of display bitmap. 

bt5 = DCReset, bl4 = ColorMode’, b13 = DCTest’ 

, b L2 = PICyBDR' 

HBorderO 

EQU 

8A6H 

End point of display bitmap, 
b15,.14 = HSyncOff1-0. bl3 = Interlace. bl2 = 

BasePIO 

HBlankO 

EQU 

8A8H 

Start left border location. (bl5,.b!2 = unused 

)• 

HBlankl 

EQU 

8AAH 

Stop right border and start blank location. 


HSyncl 

EQU 

8ACH 

Start Horiz Sync. 


HSyncO 

EQU 

8AEH 

Stop Horiz Sync. 


VCursor 

EQU 

8B0H 

Cursor y-coodinate in words, 
b15.,b12 = Mix Rule 


Vint 

EQU 

8B2H 

Vertical interrupt point. 


VBorderl 

EQU 

8B4H 

Start lower border location. 


VBorderO 

EQU 

8B6H 

Start display bitmap. 


VBlankl 

EQU 

8B8H 

End of lower border location. 


VB 1 ankO 

EQU 

8BAH 

Start upper border location. 


VSyncO 

EQU 

8BCH 

End of VSync 
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VSyricl 

EQU 

8BEH; 

Start of VSync 

BaseP 

EQU 

8C0H; 

page address of start of bitmap. 

QRandLR 

EQU 

8C2H; 

Line count (b 15, ,b7) and num of quad words 

Borderl 

EQU 

8C4H; 

border pattern for even line. 

BorderO 

EQU 

8C6H; 

border pattern for odd line. 


Constants used for Initialization 


NumHorzBytes 

NumVertBytes 

lefaultMixRule 
DCResetBit 

EQU 

EQU 

EQU 

OAH; 

09H 

OEOH; 
EQU 

Number of values in horizontal control store 
Number of values in vertical control store 

Default value for Cursor/Data mix (Daisy) 
8000H; 

;Mi sc 





NumBitMapBytes 


EQU 

32: Numbe 

r of bytes in cursor pattern 

NumBitMapBytesDaisy 


EQU 

16 ; Number of 

words in cursor pattern. 

: Flags in chngdlnfo word 




cursorPositionChngd 


EQU 

8000H ;b15 

= change in cursor position 

cursorPatternChngd 


EQU 

4000H ; b 14 

= change in cursor pattern 

borderPatternChngd 


EQU 

2000H ; b13 

= change in border pattern 

DackgroundChngd 


EQU 

1000H ; b 12 

= change in backgrond 

comniandChngd 


EQU 

0800H ; b11 

= change in command to display 

:constatns to determine 

displCntl contents for Daisy. 


pictureBorderCheckMask 

EQU 

08H 



borderOnlyMask 

EQU 

10H 



videoDisableCheckMask 

EQU 

02H 



videoDisableMask 

EQU 

OOH 



MSNibb1eMask 

EQU 

OFFFH 
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SM0D186 

$PAGELENGTH (72) 

SPAGEWIDTH (136) 

[Copyright (C) 1987 by Xerox Corporation. All rights reserved. 
DybrkCP.asm 
last edited by: 

RDH 22~Jan-86 12:06:22 [Create from parts of RAMBoot.asm. 


NAME 

DybrkCP 

$NOLI ST 

[SINCLUOE 

(EthHdFce.asm) 

$INCLUDE 

(HardDefs.asm) 

SINCLUOE 

(lOPDefs.asm) 

SINCLUOE 

(IOPMacro.asm) 

SINCLUOE 

(RAMBDefs.asm) 

;$INCLUOE 

(EthBDefs.asm) 

[SINCLUOE 

(Handlers.asm) ;to resolve handler IDs 

[SINCLUOE 

(CSBankDf.asm) 

[SINCLUOE 

SLIST 

(RAMEEP.asm) 

EXTRN 

mesaProcessorlnterrupt :ABS 

[from IORRamBt.asm: 

IOPELocal RAM 

SEGMENT AT 0 

EXTRN 

resetRegData: WORD 

IOPE Local RAM 

ENOS 

[from IORRamBt.asm: 

BootStrapIOR 

SEGMENT COMMON 

EXTRN 

IncSIFarProc: WORD 

BootStrapIOR 

ENDS 

IOPEInRAM 

SEGMENT PUBLIC 

ASSUME CS:IOPEInRAM 

ASSUME OS:BootStrapIOR 

PUBLIC 

DybrkCPConditioning 

PUBLIC 

WriteOybrkControlStore 

PUBLIC 

InitDybrkCP 


EXTRN LoadAXFromSootBuf: NEAR 

EXTRN LoadAXFromBootBufLateEntry: NEAR 

EXTRN LoadCXFromBootBuf; NEAR 

EXTRN LoadCXFromBootBufLateEntry: NEAR 

EXTRN CalIDumpCSAddrBIock: NEAR 


DybrkCPCond 


OybrkCPCond 


PROC 

FAR 

ling: 

MOV 

AX, IOPELocalRAM 

MOV 

ES, AX 

ASSUME 

£S: IOPELoca1 RAM 

CALL 

DaybreakCPHalt 

CLI 

;to protect reset 

MOV 

AX, resetRegData 

AND 

AX, NOT resetMesaProcessor 

OUT 

WriteResetReg, AX 

CALL 

DaybreakCPStart 

OR 

resetRegData, resetMesaProcessor 

MOV 

AX, resetRegData 

OUT 

WriteResetReg, AX 

CALL 

DaybreakCPHalt 

STI 

RET 

[done with reset 

ASSUME 

ENDP 

ES:NOTHING 


WriteDybrkControI Store PROC FAR 

WriteCntlStore: CALL LoadAXFromBootBufLateEntry 

;We first want to set the CS 
[bank register then get the CS 
.address that this block is to 
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;be written to. 


Wri teDaybreakCSBlock: 


WriteOaybreakCSWord: 


WriteDybrkControlStore 


DybrkInitlalizeCP 


;DayBreak's control store is an I/O port. 

;Put the cs address into OX. 

CALL LoadCXFromBootBuf 

MOV DX, CX 

;We want to point to the count 
;of CS words in this block, 

;from which we will fetch the 
;CS block size counter and 

;save it in DI - we are again out of registers! 

CALL LoadCXFromBootBuf 

MOV DI, CX ; 

MOV BP, DX 

MOV DX, daybreakBankRegister ;First let us set up the CS bank 

register. 

Also need to save initial CS adr$. 

A single control store word 

; is made up of six bytes. The 
layout of the control store with 
respect to the 4K ports is as 
follows: MMW - Mm where 
8MWH has the MSB and DWH has 
the LSB. The CS is loaded in six 
byte data streams. Update CS word count. 
Loop while not done with CS block. 


RET 


ENDP 


PROC FAR 


OUT OX, AL 

MOV DX, BP 

OR DX. daybreakCSPortMask 

MOV CX, CSWordByteSize 

CALL DWORD PTR IncSIFarProc 
MOV AL, ES: [BX][SI] 

OUT DX, AL 

ADD OX. nextCSByte 

LOOP WriteDaybreakCSWord 

INC BP 

DEC DI 

JNZ WriteDaybreakCSSlock 

CALL DWORD PTR IncSIFarProc 


InitDybrkCP: PUSHA 

%Enable(mesaProcessorInterrupt) ;turn on the interrupt, but 
%D1sableInterruptsTillNextWait ; don't allow it till we're ready 
CALL DaybreakCPStart ;let CP run 

%WaitForInterrupt (1) ;init routines should take < 1 sec 

IN AX, ClrMesalntr ;clear Mesa interrupt 

%Disable(mesaProcessorInterrupt); and turn it off 
%WaitForSystem ;drop to system level 

POPA 

CALL DaybreakCPHalt ;stop the CP (so can load more code) 

InitializeDaybreakCPRet: 

JMP CallDumpCSAddrBlock 


DybrklnitlalizeCP 


ENDP 

waitForMesalnterrupt 

PROC 

NEAR 

WaiLForMesalnt: 

;CALL 

RET 

QaisyCPHalt 

waitForMesalnterrupt 

ENDP 


BadMesalnterrupt 

PROC 

NEAR 

8adMesaInt: 

RET 


BadMesalnterrupt 

ENDP 



Restore registers, then 
halt the CP and keep 
processing the boot file. 


DaybreakCPHalt 

DybrkCPHalt: 

DaybreakCPHalt 

PROC 

MOV 

OUT 

SHL 

SHL 

RET 

ENDP 

NEAR 

AX. 0 

WriteCSReg, AX 

AX, 15 ; delay 

AX, 13 ; at least 38 cycles 

DaybreakCPStart 

PROC 

NEAR 

Dyb rkCPStart: 

MOV 

AX, 0200H 

OUT 

RET 

WriteCSReg, AX 

DaybreakCPStart 

ENDP 
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IOPEInRAM 


ENOS 


ENO 
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** 


[Copyright (C) 1984. 1985 by Xerox Corporation. All rights reserved. 

stored as [Iris]<WMicro>Dove>Handler$.asm 
created on 23-Jul-84 15:29:07 


-- 

JAC 


28-Aug-85 

15:17:17 

:add bogus 

handler for and Opie stack 

-- 

kek 


28-Aug-85 

15:17:17 

;add parity 

ROM handler 

-- 

JPM 

.es 

14-May-85 

10:00:59 

:Customize 

for next integration 

-- 

VXS 

.pa 

7-Dec-84 

17:10:38 

:Customize 

for first integration 

-- 

vxs 

.pa 

6-NOV-84 

14:36:15 

:Creation 



;Th1s file enumerates all handlers which will be linked with 
: Handlnit.asm, and is INClUDEd in that module. 

V Handler writers: to customize this file, comment out the ^Handler calls 
%’ below and/or add ^Handler calls with your handler name{s) and ID(s). 


%*DEFINE(HandlersLinked)( 

%Handler(Beep,1,PROC) 

%Handler(Disk,2.PROC) 

%Handler(Display,3.PROC) 

%Hand1er(Ethernet,4,PROC) 
%Handler(FIoppy,5,PROC) 
%Handler(KeyBoardAndMouse.6,PROC) 
%Handler(MaintPanel,7,PROC) 
%Handler(Bootstrap,8.CALL) 

%'Handler(Parity.9,PROC) 

%’Hand 1e r(Umbi1leal.10,CALL) 

% 'Handler(RemoteMemory,11.CALL) 
%Handler(System,12,) 

) 


Handlers.asm 
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; DAIS0G002,def= 5 revs up from DaisyRevC.Def 


;Copyr1ght (C) 1984, 1985 by Xerox Corporation. All rights reserved, 
stored as [Iris]<WMicro>Dove>HardDefs.asm 

%*DEFINE(Revision)(Hardware: G. DefsVerslon: 002) 

;end Revision macro definition 

;Last Edited By: 

; TXM 30-Oct-87 9:03:14 :Add Dahlia distinction 

: KEK 17-Apr-86 9:21:29 :add Daisy defs 

: JAC 24-Jan-86 10:49:04 :change 82590ptionsSlave definitions 

; JGS 27-Sep-85 12:25:47 :DisplayTypePort is OECCCH not OECCOH. 

; Jpm ll-Sep-85 8:57:09 :Add i8274NonVectored and appropriate constant changes. 

: JPM 2-Aug-85 16:32:59 :Fix EEProm segment offsets. 

; KEK 19-Jun-85 13:29:31 :remove fixed EEFDefs definitions (put into ROMEEP.asm, RAMEEP.asm, and BadPage.asm), added eep 

segment offsets. Remove duplicate defs 8259Mas, 8259Slv, also Ctl and IntCtl... 

: JPM 6-Jul-85 10:36:35 :Add 180186F1ags (from HardOpie). 

: JPM 2-Jul-85 8:09:55 :Add 18274VarVect. 

: JPM 25-Jun-85 16:56:49 :Take out software-determined EEProm constants (except byte/word flag for IOPKernl). 

: KEK 19-Jun-85 13:29:31 :add in EEProm section, containing old EEPDefs.asm and HardEEP.asm. 

; JPM 30-May-85 16:53:35 ichange i8259MasterICW3 for BO. 

: KEK 21-May-85 11:04:37 :add DisplayTypePort and DisplayTypeMask. 

: KEK 25-Apr-85 16:10:33 :more 8274 defs (used by IOPInit). Corrected I82590ptionsSlaveICW2 vector number, add some 

i82590pt ionsSlave defs. 

; KEK 5-Mar-85 11:18:16 :add ETCH TWO comment (WriteCtlReg defs). 

: KEK 26-Feb-85 21:00:32 :Add machine distinguishing constants. retraceLatch port constant, add 8274 equates. 

: VXS 15-Nov-84 12:06:42 :Add symbols for Control Register. 

; VXS 7-Nov-84 13:33:59 ;Remove ClearResetsMask 

; VXS 5-Nov-84 15:44:53 :Add defs for daybreak map register numbers 

; VXS ll-Oct-84 10:07:23 :Add Device Reset information 

; VXS 9~Oct-84 11:52:19 :Changed FDCDMADataReg to base+4 - 6 works too, but it decodes the bits seperately anyway. 

• VXS 4-Oct-84 14:41:15 :Add daybreakMapIOAddressBase 

: VXS 3-Oct-84 16:59:26 :Added FloppyTimer, since the timer is hardwired to timer 1. 

• VXS 1-Oct-84 18:46:27 :Added definitions for Floppy DMA (uses internal 186 DMA controller) 

• VXS 17-Sep-84 14:05:10 :Change def of TRUE to -1 instead of OFFFF so that can use it for bytes 

• FXB 15-Aug-84 16:29:29 :Made changes for Rev 0G002 for AKTsang 

; VXS 6-Aug-84 18:30:34 :Add OptionsSlavelnServiceRegAddr 

: VXS 6-Aug~84 12:53:55 :Use new symbols instead of *Ctlr8ase ones 

; VXS 3-Aug-84 18:54:20 :Added def for 8259 masterlnServceRegAddr 

• VXS 3-Aug-84 17:52:15 :Added Mas and Slv defs back in as duplicates for compatibility, also Ctl and IntCtl 

| VXS 3-Aug-84 14:08:21 ;changed i186*CtlAddr to 1186 *IntCtlAddr for clarity 

; VXS 3-Aug~84 14:05:39 :Added i 186Intrchanne1for* 

: VXS 3-Aug-84 11:49:18 :Changed convention for 8259 expansion from *Exp* to *Optionsslave* 

: VXS 3-Aug-84 11:31:41 :Put in Revision macro, which is documentation of what version of this file and what hardware 

revision its for 

; VXS 3-Aug-84 10:31:18 :Removed defs specific to chips and moved them to *Defs.asm 

; VXS 3-Aug-84 10:21:15 :changes *Mas symbols to *Master, *Slv to *Slave 

; FXB l-Aug-84 16:23:51 : added expansion intr cntlr constants 

| JBinkley 22-Jun-84 16:20:40 

; P. PxE for JBinkley 6-Jun-84 13:49:52 

; :Changed ICW3 to reflect slave mode of 8274 

; changed ISR & IRR for 8259 read. 

• JBinkley 20-Apr-84 13:14:22 

; updated to RevC Build by JBinkley 12-Apr-84 6:39:12 

; first written by JBinkley 21-0ct-83 with Geoff Thompson 

; This file defines 10 addresses for the Daisy IOP. 

; It also includes operation constants for hardware that is central to the system, 

; such as the 8259 interrupt controller, the 80186 processor operation constants, etc. 

; There are now seperate files for the peripheral chip operating constants, of 
: the form <chipname>Defs.asm. 

: It should be INCLUDE-ed in all 
hardware dependent code modules. 

+**** + ****** + ***********#'***'11 + ** + *** ***************** 

; DC) NOT REFER TO "1APX 86/88, 186/188 User's Manual 
; Programmer's Reference", May 1983. 

; IT CONTAINS NUMEROUS MISTAKES. 

; Refer, instead, to the 186 Application's Note 
; by Ken Shoemaker, March, 1983 
; or to the 186 Data Sheet. 

.+*+*+********************+***********+***************** 

: Conventions for labels: 

: Intn = Internal 

; Intr = Interrupt 

; Ctl = Control 

: Ctlr = Controller 

; Chip identifiers -- 
: i 186 Intel 80186 

; 18259= Intel 8259 

: 18251= Intel 8251 

; Normally, each new word in a label occurs with the first character 
; capitalized, The exception is when the previous word is all CAPS, 

; as in: PACSvalue. (When a name is defined by Intel, we use their 
; convention.) 

.**,»************ + ************* + ********* + *************** 


i80186 Internal Peripheral Control Block (PCB) 
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; This section defines the various control register addresses in the 
; 80186 on-chip Peripheral Control Block (PCB) 

; After RESET, the relocation reg = 20FFH. This means the 
; PCB will be mapped into I/O space, & 

; base address of PCB = 0FF00H. 


PCB can be relocated to any 256-byte boundary. 

For Daisy, the PCB is specified at the upper-most 256 bytes of 
the I/O space (i.e., default i186 locations) 


PCBbase EQU 

GFFOOh 




; Chip Select 

Control 

Register 

Locations 

UMCSaddr 

EQU 

PCBbase + 

OAOh 

Upper Mem (ROM) Chip Select 

LMCSaddr 

EQU 

PCBbase + 

0A2h 

Lower Mem (RAM) Chip Select 

PACSadd r 

EQU 

PCBbase + 

0A4h 

Peripherial Chip Select 





& PCS 0-3 Ready bits 

MMCSaddr 

EQU 

PCBbase + 

0A6h 

Middle Mem (RAM) Chip Select 

MPCSadd r 

EQU 

PCBbase + 

0A8h 

Middle Mem Range 





& PCS 4-6 Ready bits 

: Chip Select 

Control 

Register 

Values 



(See il86ControlBlockProgramming.doc for more detailed documentation) 
See Intel uP & P Handbook, 1983, pp.3-39 to 3-43. 

All memory sizes are specified in bytes. 


; Upper Memory Chip Select 

; 16 KBytes of EPROM, base Q OFCOOOh, 0 WS, RDY ignored 

UMCSvalue EQU 0FC3Ch ; <- (0038h -OR- 0004h -OR FCOOh) 


; Lower Memory Chip Select 

; 16 KBytes of SRAM, base @ OOOOOOh, 0 WS, wait for RDY 

LMCSvalue EQU 003F8h ; *• (0038h -OR- OOOOh -OR- 03C0h) 


; Middle Memory Chip Select 

; Possible 64 KBytes of SRAM, as 4 16K chunks 

; Only first 16 KBytes chunk is implemented, 

; base 0 OlOOOOh, 0 WS, wait for RDY 

MMCSvalue EQU 011F8h ; <- (01F8h -OR- OOOOh -OR- lOQOh) 


; Middle Memory / Peripheral Chip Se'ect 
: Possible 64 KBytes of SRAM, as 4 16K chunks 

; (addresses 010000 to 013FFF installed) 

; 7 PCS' lines, mapped into I/O space 

; PCS4-6: 0 WS, RDY ignored 

MPCSvalue EQU 088BCh ; «■ (8038h -OR- 0800h -OR- 0080h -OR- 0004h) 


; Peripheral Chip Select 
; Base 0 OOOOH, 

; PCS0-3: 1 WS, RDY ignored 

PACSvalue EQU 0003Dh ; «• (0038h -OR- 0005h -OR- OOOOh) 


Other 80186 Internal Control registers addresses 


i 186RelocationRegAddr 

EQU 

PCBbase+OFEh ;Relocation Register 


i l86Timer0IntCtlAddr 

EQU 

PCBbase+032h ;Timer 

0 Interrupt Control Register 

i 186TimerllntCtl Addr 

EQU 

PCBbase+038h ;Timer 

1 Interrupt Control Register 

i 186Timer2IntCtlAddr 

EQU 

PCBbase+03Ah 

Timer 

2 Interrupt Control Register 

;Definitions for i186 

internal 

DMA 0 





i 186DMA0IntCtl Addr 

EQU 

PC8ba$e+034h 

DMA 

0 

Interrupt Control 

Register 

i 186DMA0LowSourcePtr 

EQU 

PCBbase+OCOh 

DMA 

0 

Low order source 

pointer 

i !86DMA0HighSourcePtr 

EQU 

PCBbase+0C2h 

DMA 

0 

High order source 

pointer 

i 186DMA0LowDestPtr 

EQU 

PCBbase+0C4h 

DMA 

0 

Low order destination pointer 

i 186DMA0HighDestPtr 

EQU 

PCBbase+0C6h 

DMA 

0 

High order destination pointer 

i 186DMA0TransferCount 

EQU 

PCBbase+0C8h 

DMA 

0 

transfer count 


i 186DMA0ControlWord 

EQU 

PCBbase+OCAh 

DMA 

0 

control word 


•.Definitions for 1186 

in ternal 

DMA 0 





i 18fiDMAlIntCtlAddr 

EQU 

PCBbase+036h 

DMA 

l 

Interrupt Control 

Register 

i186DMAlLowSourcePtr 

EQU 

PCBbase+ODOh 

DMA 

1 

Low order source 

pointer 

i186DMAlHighSourcePtr 

EQU 

PCBbase+0D2h 

DMA 

1 

High order source 

pointer 

il86DMAlLow0estPtr 

EQU 

PCBbase+0D4h 

DMA 

1 

Low order destination pointer 
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il86DMAlH1ghDestPtr 

EQU 

PCBbase+-0D6h 

DMA 1 High order destination pointer 

i186DMAlTransferCount 

EQU 

PCBbase+0D8h 

DMA 1 transfer count 

i186DMAlControlWord 

EQU 

PCBbase *-0DAh 

DMA 1 control word 

i186IntVectorRegAddr 

EQU 

PCBbase*020h 

Interrupt Vector Register 

il86EOIRegAddr 

EQU 

PCBbase+022h 

Specific EOI Register 

i186IntrMaskRegAddr 

EQU 

PCBbase+028h 

Interrupt mask register 

i186PriorityMaskAddr 

EQU 

PCBbase+02Ah 

Priority Level Register 

i186InServiceRegAddr 

EQU 

PCBbase+02Ch 

In Service register 

i186IntrReque$tAddr 

EQU 

PCBbase+02Eh 

Interrupt Request Register 

i186IntrStatusAddr 

EQU 

PCBbase*030h 

Interrupt Status Register 

; 80188 Timer I/O Addresses 



i186TimerOMCWAddr 

EQU 

PCBbase+056h 

Mode/Control Word 

i186TimerlMCWAddr 

EQU 

PCBbase*-05Eh 

Mode/Control Word 

i186Timer2MCWAddr 

EQU 

PCBbase *-006h 

Mode/Control Word 

i186TimerOCountBAddr 

EQU 

PCBbase*054h 

Max Count B 

i186TimerlCountBAddr 

EQU 

PCBbase+05Ch 

Max Count B 

i186TImerOCountAAddr 

EQU 

PCBbase+052h 

Max Count A 

i186TimerICountAAddr 

EQU 

PCBbase+05Ah 

Max Count A 

i!86Timer2CountAAddr 

EQU 

PCBbase+-062h 

Max Count A 

iI86TimerOCountReqAddr 

EQU 

PCBbase+050h 

Count Reg 

i186TimerlCountRegAddr 

EQU 

PCBbase + 058h 

Count Reg 

i186Timer2CountRegAddr 

EQU 

PCBba$e+060h 

Count Reg 


80186 Internal Control registers values 


i186RelocationRegvalue 

EQU 

060FFL 

i ;RMX mode & default location 

i1861ntrVectorRegvalue 

EQU 

0038h 

;Vectors types start at 038h 

;The following channel requireme 

nts are imposed by the 186 hardware in iRMX mode 

i186IntrChanneIforTimerO 


EQU 

0 


1186IntrChannelforDMAO 


EQU 

2 


i186IntrChannelforDMAl 


EQU 

3 


i186IntrChannelforTimert 


EQU 

4 


i186IntrChannelforTimer2 


EQU 

5 


i186IntrMaskforTimerO 

EQU 

NOT (1 

SHL 

il86IntrChannelforTImerO) 

i186IntrMaskforDMA0 

EQU 

NOT (1 

SHL 

i 186IntrChannelforDMAO) 

i186IntrMaskforDMAl 

EQU 

NOT (1 

SHL 

i186IntrChannelforDMAl) 

i186IntrMaskforTimerl 

EQU 

NOT (1 

SHL 

i186IntrChannelforTimerl) 

i186IntrMaskforTimer2 

EQU 

NOT (1 

SHL 

i186IntrChannelforTimer2) 


EOI Commands for internal 


i186EOItimerO EQU 
i186EQIdmaO EQU 
i186EOIdmal EQU 
i186EOItimerl EQU 
i186EOItimer2 EQU 


Interrupt controller 

il86IntrChannelforiimerO 
i 186IntrChanne1forDMAO 
i 186IntrChanne1fo rDMAl 
i 186IntrChannelforTimerl 
il86IntrChannelforTimer2 


:80186 Flag structure 


i80186Flags 
& 

& 

& 


RECORD reservedl5tol2:4, 1801860F:1, i80186DF:l. 180186IF:1, 
180186TF:1. i80186SF:1, 180186ZF:1, reserved5:l, 
180186AF:1, reserved3:l, i80186PF:l, reservedl:l, 

180186CF:1 

PURGE reservedl5tol2, re$erved5, reserved3, reserved! 


Peripherial Device Base Addresses 

Peripherial Chip Selects are mapped into I/O space 
and start at address 0000H. 

Note : Base address of PCS's must be an integer multiple of IK. 


PCSBase EQU 

Oh 



def i 

PCSOBase 

EQU 

PCSBase 

+ 

Oh 

PCSIBase 

EQU 

PCSBase 

f 

080h 

PCS2Base 

EQU 

PCSBase 

+ 

lOOh 

PCSSBase 

EQU 

PCSBase 

+ 

18 0 h 

PCS4Base 

EQU 

PCSBase 

+ 

200 h 

PCS5Base 

EQU 

PCSBase 

+ 

280h 

PCSOBase 

EQU 

PCSBase 

+ 

300h 


PCS.O' -- used for Peripherial Controllers, 1 w.s. 
(8 bit Data Bus Devices) 


— new names as of August 3, 1984 
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i8259MasterBase 

EQU 

PCSOBase 

+ OOh 

A6-A4 

= 0 


i8269SlaveBase 

EQU 

PCSOBase 

lOh 

A6-A4 

= 1 


i8254Base 

EQU 

PCSOBase 

+ 20h 

A6-A4 

= 2 


18251Base 

EQU 

PCSOBase 

+ 30h 

A6-A4 

= 3 


18274DCommBase 

EQU 

PCSOBase 

+ 40h 

A6-A4 

= 4 


i8272Base 

EQU 

PCSOBase 

► 50h 

A6-A4 

= 5 


182590ptionsSlaveBase 

EQU 

PCSOBase 

+• 60h 

; A6-A4 

= 6 

i8255Base 


EQU 

PCSOBase 

+ 70h 

:A6-A4 

= 7 


; PCS.1' -- used for miscellaneous I/O, 0 w.s. 

; (16 bit Data 8us Devices) 


Disp1ayTypePort 

EQU 

OECCCH 



:read this to get 

display 

size data 

DisplayTypeMask 

EQU 

01H 



:if bitO = 0,then 

19" 

display else 15 

ReadlnputPort 

EQU 

PCSIBase 


Oh 

;A6-A4 = 

000b, 

R 

- -80h 

ReadHostProm 

EQU 

PCSIBase 

+ 

lOh 

;A6-A4 = 

001b , 

R 

--90h 

ClrRingLatch 

EQU 

PCSIBase 

4- 

20h 

;A6-A4 = 

010b , 

R 

--AOh 

ClrMesalntr 

EQU 

PCSIBase 

+ 

30h 

;A6-A4 = 

Ollb, 

R 

--BOh 

ClrENetlntr 

EQU 

PCSIBase 

4- 

40h 

;A6-A4 = 

100b, 

R 

--COh 

ClrRetracelntr 

EQU 

PCSIBase 

+ 

50h 

;A6-A4 = 

101b , 

R 

—DOh 

;a word IN instruction 

to this port 

will 

address the arbiter: 



ArbCmdBase 

EQU 

PCSIBase 

+ 

70h 

:A6-A4 = 

lllb, 

R 

--Fxh 


;The arbiter control will accept any combination of the bits below, and perform 
; the multiple functions specified: 


A11owPCCmdOffset 

EQU 

08H 

;add this to ArbCmdBase 

A11owRDCmdOff set 

EQU 

04H 

;add this to ArbCmdBase 

Ho!dIOPCmd 

EQU 

02H 

;add this to ArbCmd8ase 

WriteCtlReg EQU 

PCSIBase 

+ Oh 

;A6-A4 = 000b, W — 80h 

;ETCH ONE DEFS! 




CRSpeakerData 


EQU 

8000H 

CREnableTimerO 


EQU 

4000H 

CRFODMotorOn 


EQU 

2000H 

CRFDDInUse 


EQU 

1000H 

CRTimerlGenerateFloppyTC 

EQU 

0800H 

CREEPromAccess 


EQU 

0400H 

CRRS232AInternalC1ock 


EQU 

0200H 

CRRS232BEnableClockSend 

EQU 

0100H 

;ETCH TWO DEFS! (some are already defined by the ETCH ONE defs above) 

CRNotBlockSysMem 


EQU 

8000H ; ' 1 enables memory! 

: CREnableTimerO 


EQU 

4000H 

: CRFDOMotorOn 


EQU 

2000H 

: CRFDornUse 


EQU 

1000H 

: CRTimerlGenerateFloppyTC 

EQU 

0800H 

CRFDDLowSpeed 


EQU 

0400H ;1ow = ’1, hi = '0 

: CRRS232AInternalC!ock 


EQU 

0200H 

; CRRS232BEnableClockSend 

EQU 

0100H 

CRDriveSel3 


EQU 

0080H 

CRDriveSel2 


EQU 

0040H 

CRDriveSel1 


EQU 

0020H 

CRDriveSelO 


EQU 

0010H 

CRSelect250KbDataRate 


EQU 

0008H isignal "5H/8L" 

CRPcomp2 


EQU 

0004H 

CRPcompl 


EQU 

0002H 

CRPcompO 


EQU 

0001H 

CRFloppyMask 


EQU 

3CFFH 

WriteLED EQU 

PCSIBase 

+ lOh 

; A6-A4 = 001b, W --90h 

ENetAttn EQU 

PCSIBase 

+ 20h 

;A6-A4 = 010b, W --AOh 

WriteCSReg EQU 

PCSIBase 

+ 30h 

;A6-A4 = Ollb, W --BOh 

WriteResetReg EQU 

PCSIBase 

40h 

;A6-A4 = 100b. W —COh 

WriteConfigReg EQU 

PCSIBase 

4- 50h 

;A6-A4 = 101b, W --DOh 

allResetBits EQU 

07FFH 


;Al1 bits 

;The following constant 

is used 

for a LOOP $ between clearing the reset bit 

; for a device and setting it again to 

ensure that the reset signal Is held 

; low for the proper amount of time. It 

should be adjusted so that the device 

; with the longest reset 

time is 

accounted for. 

clocksPerusec 


EQU 

8 ;running at 8MHz 

clocksPerLOOP 


EQU 

16D ;from Intel handbook 

usecsPerLOOP 


EQU 

clocksPerLOOP/clocksPerusec 

maximumResetDelayinusecs 


EQU 

32D -.twice the floppy's requirement 

max imumResetDelayCount 


EQU 

maximumResetDelayinusecs/usecsPerLOOP 

;Here are the individual 

device 

reset bit masks. 

resetEthernetControl 1 er 


EQU 

1 

resetRS232CControl ler 


EQU 

2 

resetFloppyControl ler 


EQU 

4 

resetKeyboardUART 


EQU 

8 

resetUmbilical Control ler 


EQU 

lOh 

resetKeyboardControl ler 


EQU 

20h 

resetMesaProcessor 


EQU 

40h 

resetPCProcessor 


EQU 

80h 

resetDiskControl ler 


EQU 

lOOh 
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resetOiskDMAControl1er 
resetExpansionChannel 


EQU 

EQU 


200 h 

400h 


;Here are some composite device reset masks. 


resetKeyboardHardware EQU 
resetOiskHardware EQU 


resetKeyboardUART + resetKeyboardController 
resetDiskController + resetDiskDMAController 


; Interrupt Controller -- Master 18259A 

; [Programming information on Page 2-120 of 
; the Intel '84 Microsystem Components Handbook] 

%SET(i8274NonVectored,1) 


i8259MasterAddrO EQU i8259MasterBase + 0h : A1 = 0 

i8259MasterAddr1 EQU i8259MasterBase + 2h ;A1 = 1 


i8259MasterInServiceRegAddr 

EQU 

i8259MasterAddrO 

:0CW3 (A1 = 0) is in-service register when i8259ISRread 



: is given 

i8259MasterRequestRegAddr 

EQU 

iB259Ma$terAddrO 

;OCW3(A1=0) is also interrupt request register when 
; i8259IRRread is given 

18259MasterMaskRegAddr 

EQU 

18259MasterAddrl 

;This is always the mask register {read from where its 


i8259MasterICWl 

EQU 

Ollh 

: icwi. 

edge triggered, cascade mode, ICW4 needed 

18259MasterICW2 

EQU 

020h 

interrupt types 20h-27h 

%IF( # /.i8274NonVectored) 

i8259MasterICW3 

THEN ( 
EQU 

060H 

:18274 not a slave in non-vectored mode 

) ELSE ( 
i8259MasterICW3 


EQU 

070H 

; IR4 - slave 18274 --for ETCH TWO!!! 

;i8259Mas terICW3 
) FI 

18259MasterICW4 


EQU 

QE8h 

; IR3 - slave 18274 --for ETCH ONE!!! 

EQU 

Ollh 

; IR5 - 
: IR6 - 
; IR7 - 
;SFNM, 

slave i8259 
slave i80186 

slave expansion slot -- for ETCH ONE!!! 
Not Buffered, Normal EOI, 86/88 mode 


i8259MasterOCWl 

EQU 

OFFh 

;Nothing is enabled 

i8259MasterOCW2 

EQU 

0C7h 

; IR7 

has lowest priority 

i8259MasterOCW3 

EQU 

008h 

; Not 

special mask mode 

i8259Master0ebuggerInE0I 

EQU 

6ih ;specific EOI for debugger Int Handler 

i8259Al1 Enabled 


EQU 

00000000B ;A11 interrupts are enabled.. 

i8259Al1 Inhibited 

EQU 

OFFh 

;A11 interrupts are inhibited.. 

i8259Enab1eIRO 


EQU 

OFEh 

:Enable IRO (for 0CW1) 

i8259EnablelRl 


EQU 

OFDh 

;Enable IRl (for OCWl) 

i8259EnableIR2 


EQU 

OFBh 

;Enable IR2 (for OCWl) 

i8259EnableIR3 


EQU 

0F7h 

:Enable IR3 (for OCWl) 

i8259EnableIR4 


EQU 

OEFh 

;Enable IR4 (for OCWl) 

i8259EnableIR5 


EQU 

ODFh 

;Enable IR5 (for OCWl) 

i8259EnableIR6 


EQU 

OBFh 

;Enable IR6 (for OCWl) 

18259EnableIR7 


EQU 

07Fh 

;Enable IR7 (for OCWl) 


18259EOIforIRO 

EQU 

060h 

;Specific EOI 

for 

IRO 

(for OCW2) 

i8259EOIforIRl 

EQU 

061h 

:Specific EOI 

for 

IRl 

(for OCW2) 

i8269EOIforIR2 

EQU 

062h 

;Specific EOI 

for 

IR2 

(for OCW2) 

i8259EOIforIR3 

EQU 

063h 

:Specific EOI 

for 

IR3 

(for OCW2) 

i8259EOIforIR4 

EQU 

064h 

■.Specific EOI 

for 

IR4 

(for OCW2) 

i8259EOIforIR5 

EQU 

065h 

:Specif1c EOI 

for 

IR5 

(for OCW2) 

i8259EOIforIR0 

EQU 

066h 

:Specific EOI 

for 

IR6 

(for OCW2) 

18259EOIforIR7 

EQU 

067h 

;Specific EOI 

for 

IR7 

(for OCW2) 

i8269EOINonSpecific 

EQU 

20h 

;Non-specific 

EOI 

for 

8259s 

i8259ISRread 

EQU 

OOBh 

;Read In-Service-Register on 

i8259IRRread 

EQU 

OOAh 

-.next Rd pulse (for 0CW3) 

:Read Intr-Request-Register on 

;To read IMR of 18259, 

set A1 = 

1 

:next pulse Rd pulse 

(for 0CW3) 


; Interrupt Controller -- Slave 18259A 

; [Programming information on Page 2-120 of 
; the Intel '84 Microsystem Components Handbook] 


i8259SlaveAddrO EQU i8259S1 aveBase + 0h ;A1 = 0 
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i8269SlaveAddrl 

EQU 

i8259SlaveBase +2h ;A1 = 1 

18259S1avelCWl 

EQU 

01 lh 

;ICW1, edge triggered, cascade mode, ICW4 needed 

i8259SlaveICW2 

EQU 

Q30h 

;Interrupt types 30h-37h 

i8259SI ave.ICW3 

EQU 

005h 

;This 

slave is connected to IR5 of the master 

i8259S1aveICW4 

EQU 

00 lh 

; not 

SFNM, Not Buffered, Normal EOI, 86/88 mode 

i8259SlaveOCWl 

EQU 

QFFh 

;Noth 

ing is enabled 

i8259S1aveOCW2 

EQU 

0C7h 

; IR7 

has lowest priority 

i8259S1aveOCW3 

EQU 

008h 

: Not 

special mask mode 

i8259SlaveInServiceRegAddr 

EQU 

i8259SlaveAddrO 





;OCW3 (A1=0) Is in-service register when 18259I$Rread 





; is given 

i8259SlaveRequestRegAddr 


EQU 

i8259SlaveAddrO 


;OCW3(A1=0) Is also interrupt request register when 
; i8259IRRread is given 


i8259SlaveMa$kRegAddr EQU i8259SlaveAddrl 

;This is always the mask register (read from where its written) 


Interrupt Controller -- Expansion slot i8259A 

[Programming information on Page 2-120 of 
the Intel ’84 Microsystem Components Handbook] 


i82590ptionsSlaveAddrO 
i82590ptionsSlaveAddrl 

i82590ptionsSlavelCWl 
i82590pt1onsSlaveICW2 
;i82590ptionsSlaveICW3 
i82590ptionsSlaveICW4 

i8259Pol1 EQU 

i82590ptionsSlave0CWl 

i82590ptionsSlaveOCW2 

i82590ptionsSlave0CW3 


EQU 

EQU 

i82590ptionsSlaveBase +0h ;A1 = 0 

182590ptionsSlaveBa$e *-2h ;A1 = 1 

EQU 

EQU 

* * * * * * * 

EQU 

013h 

OOOh 
not used 
OOlh 

;ICW1, edge triggered, single. ICW4 needed 
;no interrupt vector generated 
********* 

;not SFNM, Not Buffered, Normal EOI. 86/88 mode 

OOCH 


;18259 in poll mode 

EQU 

EQU 

EQU 

OFFh 

0C7h 

008h 

.Nothing Is enabled 
;IR7 has lowest priority 
;Not special mask mode 


i82590ptionsSlaveInServiceRegAddr EQU i82590ptionsSlaveAddrO 

;0CW3 (A1=0) is in-service register when 18259ISRread 
; is given 


i82590ptionsSlaveRequestRegAddr EQU 182590ptionsS1aveAddrO 

;0CW3(A1=0) is also interrupt request register when 
; i8259IRRread is given 


i82590ptionsSlaveMaskRegAddr EQU 182590pt1onsSlaveAddrl 

;This is always the mask register (read from where its written) 


-- This section is for Daybreak dependent hardware parameters. 


daybreakMapIOAddressBase 

daybreakMapRegisterNumberBase 

daybreakMapIOAddressPCBase 

daybreakMapRegisterNumberPCBase 

daybreakMapIOAddressIOPBase 

daybreakMapRegisterNumberlOPBase 

niIMapData 


EQU 

EQU 

EQU 

EQU 

EQU 

EQU 

EQU 

OEOIOH 

0 

OEOIOH 

daybreakMapRegisterNumbef 
0E018H 

8 

OFFH; illegal map reg dai 

This section is for Daisy dependent 

hardware 

parameters. 

da isyMapIOAddressBase 

EQU 

0804H 


daisyMapRegisterNumberBase 

EQU 

0 


daisyMapIOAddressPCBase 

EQU 

daisyMapIOAddressBase 

daisyMapRegisterNumberPCBase 

EQU 

daisyMapRegisterNumberBase 

daIsyMapIOAddressIOPBase 

EQU 

daisyMapIOAddressBase 

daisyMapRegisterNumberlOPBase 

EQU 

8 


maxChipCount 

EQU 

4 ;number Of A-chips at one time. 


This section defines IOP device addresses. 

Device control symbols appear in the respective definitions file for the 
device. 


Intel (i8251) 


KeyBdUartData 

EQU 

i8251Base 

+ Oh 

;A1 = 0. 

R/W 

KeyBdUartCtl 

EQU 

1825 IBase 

+• 2h 

;A1 = 1, 

W 

KeyBdUartStatus 

EQU 

18251Base 

+ 2h 

;A1 = 1. 

R 


;Timers (i82 5 4) 
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; [Programming information on Page 2- of 
; the Intel '84 Microsystem Components Handbook] 


i8254CountO 

EQU 

18254Base 

+ 

Oh 

:A2-A1 = OOh, 

R/W 

18254Countl 

EQU 

i8254Base 

+• 

2h 

;A2-A1 = Olh, 

R/W 

18254Count2 

EQU 

18254Base 


4h 

; A2-A1 = 10h, 

R/W 

18254Ctlr 

EQU 

i8254Base 

+ 

6 h 

: A2-A1 = ilh, 

W 


RS232C Channels (18274) 


[Programming information on Page ???] 


18274DCommADataAddr 

EQU 

i8274DCommBase 

+ Oh ;A2-A1 = OOb 


i8274DCommACtlrAddr 

EQU 

18274DCommBase 

*■ 4h ; A2-A1 = 10b 


182 74DCommBDataAddr 

EQU 

i8274DCommBase 

+■ 2h ; A2-A1 = 01b 


i82 74DCommBCtlrAddr 

EQU 

i8274DCommBase 

+■ 6h ; A2-A1 = lib 


i8274WriteRegisterO 

EQU 

0 




18274WriteRegisterl 

EQU 

1 




i82 MWri teReg ister2 

EQU 

2 




182 74Wr1teRegister3 

EQU 

3 




18274WriteRegister4 

EQU 

4 




i8274WriteRegister5 

EQU 

5 




18274WriteRegi$ter6 

EQU 

6 




i8274WriteRegister7 

EQU 

7 




i8274ReadRegisterO 

EQU 

0 




i8274ReadRegisterl 

EQU 

l 




l82/4ReadRegister2 

EQU 

2 




i8274EOIPort 

EQU 

i8274DCommACtlrAddr 


i8274EQICommand 

EQU 

G38h 


;can only be sent to 

chA. 

i8274RstChannelCommand 

EQU 

18 H 



18274RstRxCRCCommand 

EQU 

50H 




i8274RstTXCRCCommand 

EQU 

90H 




i8274RstIntrCommand 

EQU 

OlOh 


;for either ch. 


18274RStErrorCommand 

EQU 

030h 


;for either ch. 


%IF(%i8274NonVectored) 

THEN ( 





182740pielnitCommand 

EQU 

00010100B 


;RTS’,non-vectored, 

8086 mode. 




Rx* 

priority, both interrupt run. 


) ELSE ( 

i82740pielnitCommand 

EQU 

00110100B 


:RTS'.vectored. 8086 

mode. 

) FI 

i8274VarVect 



Rx* 

priority, both interrupt run. 


EQU 

04H 


:WR1. ch. B: variable vectored 


Interrupts 


; Burdock Umbilical Port (i8255) 

; [Programming information on 
; the Intel '82 Data Component Catalog] 


18255portA 

EQU 

i8255Base+0h 

:(R.W) 

i8255portB 

EQU 

i825SBase+2h 

;(R,W) 

i8255portC 

EQU 

i8255Base-*-4h 

: (R.W) 

i8255ctl 

EQU 

i8255Base+6h 

:(W only) mode Instruction, bit set/reset 


Floppy Oise Controller (i8272) 
[Programming information on Page 9-146 of 
the Intel '82 Data Component Catalog] 


FDCStatusReg 

EQU 

i82728a$e + Oh 

A1 




FDCDataReg 

EQU 

i8272Base + 2h 

A1 




FDCDMAQataReg 

EQU 

i8272Base + 4h 

A2, 

A1 = 1. 0 


FDCMotorPort 

EQU 

WriteCtlReg 

its 

in the general 

control register 

;Timer l external clock 

is connected to FDC 





FIoppy TimerMCWAddr 

EQU 

i 186TImerlMCWAddr 

T imer 

1 is used by 

Floppy. 

FIoppy TimerMaxCountReg 

EQU 

i 186T1merlCountAAddr 

T imer 

1 Is used by 

Floppy. 

FIoppyTimerCountReg 

EQU 

i186TimerlCountRegAdd r 

T imer 

1 is used by 

Floppy. 

FIoppyTimerlntCntrlReg 

EQU 

i186TimerllntCtlAddr 

T imer 

1 is used by 

Floppy. 

;Definitions for 186 DMA 

controller connected to floppy disk: 




FloppyDMAIntCtlAddr 

EQU 

i 186DMA0IntCtlAddr 

DMA 

0 

Interrupt Control Register 

FloppyDMALowSourcePtr 

EQU 

i 186DMA0LowSourcePtr 

DMA 

0 

Low order source pointer 

FloppyDMAHighSourcePtr 

EQU 

i 186DMA0HighSourcePtr 

DMA 

0 

High order source pointer 

FloppyDMALowDestPtr 

EQU 

i186DMA0LowDestPtr 

DMA 

0 

Low order destination pointer 

FIoppyDMAHighDestPtr 

EQU 

i 186DMA0HighDestPtr 

DMA 

0 

High order destination pointe 

FloppyDMATransferCount 

EQU 

i186DMAQT ransferCount 

DMA 

0 

transfer count 

FloppyDMAControlWord 

EQU 

i 186DMA0ControlWord 

DMA 

0 

control word 



;ResetFDC EQU PCSIBase + 4h See Above.. 

;ResetFDCnRS232 EQU PCSIBase + 4h See Above... 
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; Ethernet controller equates (i82586) 
; (Fill in later. ..) 


Processor Interrupt Source types 


; Constant Equates 


TRUE 

EQU 

-Ih 

FALSE 

EQU 

Oh 

ZERO 

EQU 

Oh 

; System memory 

sizes 


OneK 

EQU 

1024 

LowRamStart 

EQU 

0 

LowRamSize 

EQU 

16*0neK 

MidRamStart 

EQU 

OlOOOh 

M idRamSize 

EQU 

16*0neK 

StackSlze 

EQU 

256 

RomStart 

EQU 

OFCOOh 

RomSize EQU 

16*0neK 


NumOfInterrupts 

EQU 

256 


;Used for calculations 
;Start at Absolute 0 
;16K bytes (16384d=04000h) 
;Start at Address 010000 
;1QK bytes (16384d=04000h) 
;256 bytes (lOOh) 

;Start at absolute FFCOOh 
;16K bytes ( 16384d = 04000h) 

;256 Interrupt Types 


EEProm Definitions: 


ETCH ONE/HYBRID Data for WriteConfigReg (from HardDefs) 


; EEPEnable 

EQU 

8000H 



:EEPWriteDataMask 

EQU 

1000H 



jEEPClk 

EQU 

0100H 



;ETCH TWO Data for WriteConfIgReg (from 

HardDef s) 


EEPEnable 

EQU 

1000H 



EEPWriteDataMask 

EQU 

8000H 



EEPClk 

EQU 

2000H 



;Oata for ReadlnputReg 

(from 

HardDefs) 



EEPReadDataMask 

EQU 

0800H 



EEPStatusReady 

EQU 

0800H 



; Command codes 
EEPCmdRead 

EQU 

80H 

;lOaaaaaa, 

where aaaaaa 

EEPCmdWrite 

EQU 

40H 

;01aaaaaa 


EEPCmdErase 

EQU 

OCOH 

;1laaaaaa 


EEPCmdEWEnable 

EQU 

30H 

;0011xxxx. 

where xxxx = 

EEPCmdEWDisable 

EQU 

OOH 

;OOOOxxxx 


EEPCmdReset 

EQU 

20H 

;0010xxxx 


;Word or byte offset constants 



bytesInEEProm 

EQU 

128 



byteEEPromOffset 

EQU 

OOOOH 



wordEEPromOffset 

EQU 

0100H 




= word address 


don’t care 


;Segment offset constants (high byte must be 00/10/20H shl'ed by 1 for IOPKernl) 


ROMsegment 

RAMSegment 

badPageSegment 


EQU OOOOH 
EQU 2000H 
EQU 4000H 


The bit 5 and 6 of machinelDPort and DaisyDisplayTypePort encode the machine type. 
These assignments are the following: 


flit 6 Bit 5 


Machine ID 


0 

0 

1 

1 


0 Daisy with 19" display 

l Daisy with 15" display 

0 Dahlia 

1 Daybreak 


Daisy Daybreak Distinction: 


machinelDPort 

EQU 

0080H 

; query here 

to get 

a machine ID 

machinelDMask 

EQU 

0040H 

;only these 

2 bits 

hold the ID. 

Daisy 

EQU 

OOOOH 

;machine ID 

= this 

if Daisy. 

Daybreak 

EQU 

0040H 

imachine ID 

= this 

if Daybreak. 


: Daybreak Dahlia Distinction: 




machineIDMask2 

EQU 

0020H 

;only these 2 bits 

hold the ID 

Dahlia 

EQU 

OOOOH 

;machine 

ID = this 

if Dahlia. 

Daytireak2 

EQU 

0020H 

;machine 

ID = this 

if Daybreak 

: Dyisy (only) 

15"/19" 

screen size 

Di st i nction: 
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DaisyDisplayTypePort 

EQU 

0080H 

;query here to 

get display type 

DaisyDIsplayTypeMask 

EQU 

0020H 

;only this bit 

holds the type. 

Daisyfifteenlnch 

EQU 

0020H 



Daisynineteenlnch 

EQU 

OOOOH 



End of HardDefs 
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;Copyright (C) 1984, 1985 by Xerox Corporation. All rights reserved. 

stored as [Idun]<WDLion>Dove>IOPDefs.asm 
created on 14-Feb-84 11:13:22 

This file contains public definitions which Opie exports to its clients. 
;-- Any hardware dependent defintions which Opie uses can be found in 
:— hardOpie.asm, and Opie’s private definitions are found in OpieDefs.asm. 

;— last edited by: 


JPM 24-Jul-85 L2:0G:42 
J PM 26-Jun-85 15:40:03 
JPM 24-Jun-85 9:11:00 
JPM 20-Jun-85 10:25:05 
JPM 15-May-85 13:42:34 
KEK 1 l-Mar-85 17:40:56 
KEK 2-Mar-85 19:07:37 
VXS 27-NOV-84 11:48:31 
VXS 20-Nov~84 22:15:55 
VXS 20-Nov-84 17:06:21 
VXS 20-Nov-84 15:13:45 
VXS 15-N0V-84 11:53:21 
VXS 14-Nov-84 12:59:30 
VXS 5-Mov-84 16:07:55 
VXS l-Nov-84 13:19:02 
VXS 17-Oct-84 16:34:14 

VXS L6-0ct-84 19:26:32 
VXS 12-Oct-84 18: 19:09 
VXS 11-Oct-84 11:39:44 
VXS Ll-Oct-84 10:10:30 
VXS 4-Oct-84 19:15:42 
VXS 4-0ct 84 18:05:23 
VXS 4-0ct-84 17:24:28 
VXS 4-0ct-84 15:48:25 
VXS 3-0ct-84 16:58:18 
VXS l-0ct-84 19:54:31 
VXS 1-Oct-84 19:04:27 

VXS 1-Oct-84 16:13:19 
VXS 26-Sep-84 15:46:20 
VXS 25-Sep-84 12:48:20 
VXS 24-Sep-84 18:30:22 
VXS 18-Sep-84 20:22:01 
VXS l7-Sep-84 18:47:01 
VXS 17-Sep-84 17:04:20 
VXS 6-Sep-84 14:26:26 
VXS 27-Aug-84 15:58:46 
VXS 27-Aug-84 15:28:33 
VXS 23-Aug-84 15:53:58 
VXS 22-Aug-84 16:57:58 
VXS 22-Aug-84 11:12:35 
VXS 14-Aug-84 12:32:57 
VXS 14-Aug-84 12:05:25 
VXS 7-Aug-84 13:58:01 

VXS 3-Aug-84 13:20:26 
VXS 19-Jul-84 18: 16:47 
VXS 12-Jul-84 16:35:09 
VXS ll-Jul-84 16:28:56 

JPM ll-Jul-84 11:24:39 
VXS 9-Ju1-84 18:23:32 
VXS 5-Jul-84 16:14:29 


JPM 3 -Jul-84 14:31:37 
FXB 29-Jun-84 16:18:18 
JMM 27-Jun-84 15:07:10 
VXS 24-Jun-84 14:36:36 

ETN 26-Jun-84 15:30:15 
JMM 22-Jun-84 7:06:32 
ETN 21-Jun-84 18:33:26 
JMM 19-Jun-84 22:05:24 
JMM 17-Jun-84 6:39:19 
JMM 10-Jun-84 17:29:33 


:Added extendedBusPageOpieAddress 

:Removed Crash macro 

:Change taskContextBlock again 

:Change taskContextBlock 

:Opie redesign 

:fixed returnSPSS fatfinger 

:add returnSPSS. remove unexpaectedlnterrupt and WatchDogTimeout. 

:Change DW to DB SIZE QueueEntry in TCB definition. 

;Move def of conditionTimeout to lOPMacro.asm 

.Take out hardware dependent non-exported definitions and move them into HardOpie.asm 
:change TCB structure item queue to taskQueue to avoid naming conflict. 

-.Add ControlRegData to I0PEFC8 
:Introduce QueueEntry structure 
:Add map register memory image. 

:add conditionTimeout definition 

ichange floppy and options DMA channels to il86IntrChannelforDMAO and i186IntrChanne1forDMAl 
: instead of 1 and 2. Also change to using 1186IntrChannelforTimer2 for the IOPE timer. 

:Add byte to TCB to make it an even number of words. 

:add new location to TCB so can restart a task. 

;Added mesa page map stuff to IOPE FCB 
:Remove Allow? macros 

:Add OpieAddressLow to be consistent with OpieAddressHigh alias. 

:Add AllowRDC and AllowPC macro definitions for SystemLoop 
:Add map register assignments. 

;Add TCB location generalMapOata 

:Moved FloppyTimer stuff to HardDefs since timer 1 is hardwired to floppy stuff. 

:Changed some "sizeof" variables to use SIZE of the structure rather than use number by hand 
:Added definitions to allocate timer 0 to the floppy disk handler 
Corrected Spelling of IOPETimelntCntrlReg to IOPETimerlntCntrlReg 
.•Remove client condition definition bit (8000) 

:Changed GENONIY listing stuff at Interruptcontrol1ers macro call 
Eliminate MesaLogicalByte from Opie Addresses 
:Change GEN to GENONLY for better listings. 

:Fix save,gen, restore stuff to be in first column 

:Add symbols for interrupt trouble routine AX indicator values 

: Add save .gen.restore around macro expansions to show symbol definitions 

:Add new Crash macro. 

:Add 182590ptionsSlaveIntrptMaskPort symbol . 

:Redefine Opie Addresses 

:change sizeOf???AvaiTable in IOPEFCB to endOf 
:Added 1186Log1calOpieAddress (for ds:offset things) 

:Put In equates for Opie Addresses. Make IOPEFCB same size as TCBs are (why? find out later) 
:Change taskcontextblock for private stacks (take out entryipcs. put in taskSPSS) 

:Get rid of sizeofTCB 

:Change IntrptVctBase to IntrptVctType for correctness 
: Also SoftwarelnterruptBase - Type 

:Take out hardware stuff, will now be found in HardDefs.asm 
:Put in $GEN directive 

:Moved Devices macro here so lOregion can use it 
:Took out device specific symbol defs, put them into 
: seperate Definitions files. 

:added EEProm indexes (first pass per PJT, 25-Jun-84) 

:fixed erroneous definition of i8259EOINonSpecific 

.•changed sizeofICB def to use SIZE 

:removed individual ICB symbol definitions, replaced 

: with Devices macro in IOPData.asm 

:Fixed error in EOI command port 

:added wordsInEEProm 

:added Umbilical Handler constants 

:Compatible with Opie Version l release. 

:Changed i80186S1avelntrptOn to include all 
slave interrupt channels on the master 
:TCB struc. 

:M1sc. fixes. 

:Remove IORegion EQUs 
:Misc. fixes. 

:structure updates. 

:Version 1 release. 


$NOGEN 


Constant Equates 


LowNibbleMask 

EQU 

OFH 

HighNibbleMask 

EQU 

OFOH 

Nul 1 

EQU 

OH 

Nibble 

EQU 

4H 


|Opie DATA STRUCTURES: 
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Condition 


STRUC 


TCBLInkPtr 

Condition 

sizeOfCondition EQU 

DW 

ENDS 

SIZE 

7 

Condition 



nonNi'IPtr 

EQU 

8000H 


;Since 0 is a valid offset, high bit in TCBLinkPtr 
; signifies non-null ptr 

preNotifyFlag 

EQU 

0001 H 


;If In the TCBLinkPtr for condition variable, 

; means prenotify has happened. 

ClientCondition STRUC 

handlerlD 

DB 

7 

; ID 

of client 

conditionRelMaskPtr 

DB 

? 

; = 

(maskPtr - conditionPtr) 

conditionPtr 

DW 

7 

: in 

client's IORegion segment 

cl ientMask 

ClIentCondition ENDS 

DW 

7 

; if 

0 , conditionRelMaskPtr ignored 

sizeOTClientCondition 

EQU 

SIZE Cl ientCondition 


Here are definitions for Opie Addresses. 

An Opie address is a 32 bit quantity which Is capable of describing the various 
address spaces and variations on those address spaces encountered in the IOP. 

The addresses are defined as a structure here for clarity, but it may be 
more convenient in actual coding to just use the type equates, and not use 
the structure offsets. 

Although this is not guaranteed for all future releases, the type field can 
bo thought of as being broken up Into 3 fields: 

Bits 7-6 Logical Address Space Selector 

Bits 5-4 Format Determination (Nil, Byte, Word. Page) 

Bits 3-0 Base Specification (dependent on Logical Address Space) 

There are several types of nil Opie Address, but only one is really supported. 

See OpieAddresses.txt for further discussion of these types. 

mesaLogical is mesaVirtual with real memory guaranteed to be behind the involved pages. 


nilOpieAddress 

EQU 

0 

extendedBusOpieAddress 

EQU 

010H 

extondedBusPageOpieAddress 

EQU 

030H 

lOPLogicalOpieAddress 

EQU 

050H 

IOPIORegionOpieAddress 

EQU 

051H 

PCLogical OpieAddress 

EQU 

090H 

mesaLogicaIWordOpieAddress 

EQU 

OEOH 

mesaEnvBaseWord 

EQU 

OE1H 

mesaLogicalPageOpieAddress 

EQU 

OFOH 


OpieAddress STRUC 


0pieAddressA15toA0 

DW 

? 

;bits 15 to 0 

OpieAddressA23toA16 

DB 

7 

: b its 23 to 16 

OpieAddressType 

DB 

7 

;first byte is type, see equates above 

OpieAddress 

ENDS 



;If OpieAddressType = 

IOPIORegionOpieAddress 

OpieAddressHandlerlD 

EQU 

BYTE 

PTR OpieAddres$A23toA16 

;For accessing the high word as 

a word (low provided for consistency): 

OpieAddressHigh 

EQU 

WORD 

PTR OpieAddressA23toA16 

OpieAddressLow 

EQU 

WORD 

PTR Qp1eAddressA15toAO 


;Map register assignments (machine independent) 



PCEMapRegisterBase 

EQU 

0 ;base is 

zero 


IORegionMapRegister 

EQU 

8+0 

;Has lower 

16k shadowed by EPROM 

mesaVMMapRegister 

EQU 

8+1 



comRecMapRegister 

EQU 

8+2 



comSendMapReglster 

EQU 

8+3 



f1oppyOMAMapRegister 

EQU 

8+4 



optionDMAMapRegistar 

EQU 

8+5 



genera!MapReg ister 

EQU 

8+6 



spareMapRegister 

EQU 

8+7 

;Has upper 

16K shadowed by EPROM 
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QueueEntry 


STRUC 


IOPEQueueType 

DB 

? 

-,e.g. system, timer 

nextHandlerlD 

DB 

7 

;ID of next task in queue 

nextTCBLInkPtr 

DW 

7 

;offset of next task 

QueueEntry 

ENDS 




taskContextBlock 

STRUC 



taskQui5ue 

DB 

(SIZE QueueEntry) DUP (?) 

taskCondltion 

DW 

7 

;if in waitForCondition state 

taskICPtr 

DW 

7 

;set by ThisTaskServices 

taskSP 

DW 

7 

;holds stack pointer while waiting 

returnSPSS 

DW 

7 

;holds return-from-int addresses 


DW 

7 


taskState 

DB 

7 

;Bits 7-4 Previous state. Bits 3-0 Present state 

taskHandlerlD 

DB 

7 

;set by InitializeTask 

timerValue 

DW 

7 

;counted down by timer 

taskContextBlock 

ENDS 




ICBcodeBytes EQU 6 ;PUSHA, CALL FAR GenericlnterruptProcessing 

interruptContext STRUC ;do not alter the order of the fields! 

interruptStatus DB ? ;task waiting, active, timed out, ... 

interruptHandlerlO DB ? ;for task servicing this interrupt 

interruptTCBLinkPtr DW ? ;task (set by ThisTaskServices) 

interruptTimerValue DW ? :counted down by watchdog (set by WaitForlnterrupt) 

watchdogLInkPtr DW ? ;next IC In watchdog queue 

troubleIPCS DW ? ;proc called for unexpected interrupt 

DW ? ; (set by ThisTaskServices) 

interruptMask DB ? ;used for enable/disable 

InterruptSlaveEOIcmd DB ? ;used to clear interrupt 

1nterruptControl1er DW ? :11nk to controller STRUC (private) 

interruptContext ENDS 

sizeOfIC EQU (SIZE InterruptContext) ;in bytes! 

variableSIzeOfIC EQU interruptMask-interruptStatus 

;***equals number of bytes in the 
; interruptContext that are variable 

interruptContextBlock STRUC 

ICBcode DB ICBCodeBytes DUP (?) 

ICBcontext DB (SIZE InterruptContext) DUP (?) 

i nterruptContextBlock ENDS 

sizeQflCB EQU (SIZE interruptContextBlock) ;in bytes! 

%*DE,FINE( softwarelntrptVctType) () ;tell IOPMacro this is not defined. 
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-.Copyright (C) 1984, 1985 by Xerox Corporation. All rights reserved. 


-- stored as [Idun]<WDLion>Dove>IOPMacro.asm 
-- created on 14-Feb-84 11:13:22 


last edited by: 


__ 

KEK 

ll-Aug-86 

16:57:43 

... 

KEK 

1 Aug 85 

18:37:33 


J PM 

22-Jul-85 

13:46:58 

n 

iddress specification). 


-- 

J PM 

18-Jul-85 

9:34:57 

-- 

J PM 

16-Jul-85 

9:25:16 

-- 

J PM 

28-Jun-85 

13:07:01 

-- 

JPM 

25-Jun-85 

17:33:54 

-- 

JPM 

24-Jun-85 

9:13:53 

-- 

JPM 

18-Jun-85 

13:15:01 

-- 

JPM 

24-May-85 

13:40:15 

-- 

JPM 

15-May-85 

13:52:31 

-- 

kEK 

2-Mar-85 

19:07:10 


kEK 

19-Feb-85 

14:49:37 

-- 

VXS 

26-N0V-84 

16:19:25 

-- 

VXS 

20-Nov-84 

22:17:23 

-- 

VXS 

15-Nov-84 

13:50:25 

-- 

VXS 

5-Nov-84 

18:04:31 


VXS 

5-Nov-84 

17:59:29 


VXS 

15-Oct-84 

10:19:33 

-- 

VXS 

12-Oct-84 

18:32:25 


VXS 

lO-Oct-84 

18:36:41 


vxs 

3-0ct-84 

11:35:44 

-- 

VXS 

28-Sep-84 

18:11:40 


vxs 

20-Sep-84 

19:50:58 

-- 

vxs 

19-Sep-84 

17:30:01 

-- 

vxs 

17-Sep-84 

16:52:02 

— 

vxs 

31-Aug-84 

15:37:69 

-- 

vxs 

31-Aug-84 

15:28:58 

-- 

vxs 

28-Aug-84 

12:06:40 

-- 

vxs 

27 -Aug-84 

17:48:59 

-- 

JPM 

20-Aug-84 

16:15:31 

-- 

vxs 

21-Aug-84 

18:01:35 


vxs 

16-Aug-84 

12:36:59 

__ 

vxs 

6-Aug-84 

17:38:28 

-- 

JPM 

6-Jul-84 

11:20:29 


JPM 

3-Jul-84 

13:57:45 

-- 

FXB 

2-Jul-84 

14:25:36 

-- 

JPM 

2-Jul-84 

13:57:56 

-- 

JMM 

27-0un-84 

15:17:44 

-- 

ETN 

26-Jun-84 

15:20:54 

-- 

ETN 

21-Jun-84 

18:33:54 

— 

JMM/ETN 

21-Jun-84 

18:33:54 

-- 

JMM 

10-Jun-84 

17:14:13 


:changes for multiple options support 
:Chartged ReadEEProm macro. 

:Changed order of loading parameters in NotifyCl ientCondition (load BX last since might be used 

:Changed SetupOpieAddressInCXDX to use struc fields. 

:Added WORD PTR to client condition MOVs. 

.•Separated SystemCalls into ROM and RAM portions (RAM empty for now). 

:Changed macros which use interruptName (no EXTRNs). 

:Changed ReadEEProm. 

:Add GetlntervalTimer; use SI for all taskPtr parms. 

:Remove alternate locking from MesaLockedOut macro 

:Op 1e redesign 

:add interruptTimeout 

:Add PUSH/POP ES to WaitForMumble. cleaned up code format 
:Fix bug in ClientCondit ion (include code inside generateEScal 1) 

:add conditionTimeout definition. 

:Add ControlRegister macro. 

:add RegisterPCEStartRoutine, Cal 1PCEStartRoutine 

:Add SI-DI arg to restart for runtime determination of restart address 
:Install Reset macro 
ilnstall Restart macro 

:Changed Reset macro to do a software interrupt instead of inline code. 

:Fix confusion on SetupOpieAddressInCXDX macro 

:Put delay test cx,[bx] instruction in MesaLockedOut macro 

:Fix NotifyClientCond1tion macro bugs 

:Add EstablishlOPAccess 

:Change NotifyClientcondition to use LEA instead of macro 

:Use a macro to generate System call instructions, and so can use it in IOPData.asm. 

:Added NotifyClientcondition macro, INT 

:Changed arg to Subinterrupt to be just interrupt name rather than interruptType 

:Added new Subinterrupt macro definition 

:Took spaces out of MesaLockedOut string compares 

:Added MinimumStackSize defintiion 

:Change Initialize Task for private stacks. 

:Changed SoftwarelnterruptBase to Type 
:Removed MesaLockedOutMemToMem. 

:Added ReadEEProm. 

:added Bindweedlntr Codemacro 
:Added MesaLockedOutMemToMem, 

:Compatibl9 with Opie Version 1 release. 

:InitializeTask change. 

:Restored EstablIshlOPAccess. 

:Deleted Converts, etc. 

:Ver$ion 1 release. 



IOPMacro 

|IMPORTED VARIABLES: 



;Gerierate INT Instructions using two data bytes 
InterruptCode EQU OCDH 

;The following must match the equivalent definition in HardOpie.asm. If it doesn't, an error will be generated by the linker. 

%IF (%NES(%softwareIntrptVctType,Qefined)) 

THEN ( 

PUBLIC softwarelntrptVctType 
softwarelntrptVctType EQU 96 

)FI 


;System Macros: 

%*OEFINE (SystemCalls) 

( 

%SET(n,0) 

%*DEFINE(whereDefined)(ROM) 
%SystemCal1(Cal 1PCEStartRoutine) 
%SystemCall(ControlRegister) 
%SystemCall(ConvertAddress) 
%SystemCal1(Disable) 

%SystemCall(Enable) 

%SystemCal1(EstablishHandlerAccess) 
%SystemCal1(EstablIshlOPAccess) 
%SystemCal1(GetlntervalTimer) 
%SystemCal1(GetLockMask) 

7«SystemCal 1 (GetWorkMask) 

%SystemCal1(InitializeTask) 
%Systen»Cal 1(Jam) 

%SystemCal1(MesaLockedOut) 

%SystemCa11(NotifyClientcondition) 
%SystemCall(NotifyCondition) 
%SystemCal1(NotifyHandlerCondition) 
"/oSystemCal 1 (ReadEEProm) 

%SystemCa11(RegisterPCEStartRoutine) 
%SystemCal1(Reset) 

OSystemCal1(Restart) 
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%*DE FINE 

%SystemCal1s 


;Lower level support r 
;Macro to setup CX-OX 
%*DEFINE 


:User cal led Macros: 
%*DEFINE 

% + OEFINE 


%*DE FINE 

X+OEFINE 


%*DE.FINE 

7,*DE FINE 


%*DEFINE 


’/.♦DEFINE 


7oSystemCal 1 (ThlsTasHServices) 

%SystemCal1(WaitForCondition) 

%SystemCal1(WaitForlnterrupt) 

%SystemCal1(WaitForSystem) 

%SystemCal1(WaitForTIme) 

%*DEFINE(whereDeflned)(RAM) 

%SystemCal1(GetOptionsInterrupt) 

%SystemCall(ReleaseOMAChannel) 

%SystemCa11(WaitForDMAChanneI) 

) 

(SystemCall (Name)) 

%Name%(SIVType) EQU softwareIntrptVctType>%n 

%SET(n,%EVAL(%n+l)) 

) 


lacros: 

with an Opie address if the argument isn’t CX-DX 

(SetupOpieAddressInCXDX (OpieAddressEA)) 

( 

7,1 F (%NES(%0p1eAddressEA,CX-DX)) 

THEN ( 

MOV CX,%OpieAddres$EA.OpieAddressHigh 
MOV OX, 7,0p i eAdd re s s EA. Op ie Address Low 

)FI 

) 


{CallPCEStartRoutlne) 

C 

OB InterruptCode, LOW CallPCEStartRoutineSIVType 

) 

(ControlRegister (mask, value)) 

( 

•/.IF (%NES (%mask.CX)) 

THEN (MOV CX, "/.mask 

)FI 

%IF ("/.NES (Xvalue.AX)) 

THEN (MOV AX, "/.value 

)FI 

DB InterruptCode, LOW ControlRegisterSIVType 

) 

(ConvertAddress (OpieAddressEA)) 

( 

"/SetupOpieAdd res s I nCXDX( "/.OpieAddressEA) 

OB InterruptCode, LOW ConvertAddressSIVType 

) 

(Disable (interruptName)) 

( 

%IF ("/.NES ("/.interruptName,BX)) 

THEN (MOV BX, "/interruptName 
) FI 

DB Interrup tCode, LOW Disab IeSIVType 

} 

(DisablelnterruptsTillNextWait) 

( 

CLI 

) 

(Enable (interruptName)) 

( 

/IF {%NES ("/.interruptName ,BX) ) 

THEN (MOV BX, /.interruptName 
)FI 

DB InterruptCode, LOW EnableSIVType 

) 

(EstablishHandlerAccess (handlerlD)) 

( 

%IF (“/NES (XhandlerlD.AX) ) 

THEN (MOV AX, WlandlerlD 

5 FI 

DB InterruptCode, LOW EstablishHandlerAccessSIVType 

) 

(EstablishlOPAccess (MapNo,OpieAddressEA)) 

( 

"/.IF (5SNES ("/.MapNo , AX)) 

THEN (MOV AX. "/.MapNo 

) FI 

“ZSetupOp ieAdd ressInCXDX(%Op ieAddressEA) 

DB InterruptCode, LOW Es tabl ish'IOPAccessSIVType 

) 


IQPMac ro.asm 
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^♦DEFINE 


7. + 0EFINE 


%*DEFINE 


%*DEFINE 


%*DEFINE 


’/.♦DEFINE 


’/.♦DEFINE 


"/.♦DEFINE 


(GetLockMask) 

( 

DB InterruptCode, LOW GetLockMaskSIVType 

) 

(GetInterval Timer) 

( 

DB InterruptCode, LOW GetlntervalTimerSIVType 

) 


(GetWorkMaskForCondition (condItionPtr)) 

( 

%IF (%NES (%conditionPtr,BX)) 

THEN (MOV BX, %conditionPtr 

)FI 

DB InterruptCode, LOW GetWorkMaskSIVType 

) 


(Initial 

( 

7, IF 


% IF 

%IF 


7, IF 

OB 


izeTask (handlerlD, taskPtr, initLoc. initialStackPtr)) 

(7.NES (7.handlerID,AX)) 

THEN (MOV AX, 7.handlerID 

)FI 

(7.NES (%taskPtr, SI)) 

THEN (MOV SI, "/.taskPtr 

)FI 

(%NES (7.initLoc,CX-DX)) 

THEN ( 

MOV CX, OFFSET %initLoc 

MOV DX, CS 

)FI 

(%NES (%initialStackPtr,DI)) 

THEN (MOV DI, ^initialStackPtr 

)F! 

InterruptCode, LOW InitializeTaskSIVType 

) 


(Jam (handlerlD, taskPtr)) 

( 

%IF (7.NES (7,handlerID, AX)) 

THEN (MOV AX, 7.handlerID 

)FI 

7.IF (7.NES (%taskPtr,SI)) 

THEN (MOV SI. %taskPtr 

) FI 

DB InterruptCode, LOW JamSIVType 

) 


(MesaLockedOut (operation, dataPtr, dataRegOrVal, lockMask)) 

( 

7.IF (%NES (%dataRegOrVal,AX)) 

THEN (MOV AX, %dataRegOrVal 

) FI 

7.IF (%NES (7.dataPtr,BX)) 

THEN (MOV 8X, %dataPtr 

) FI 

7.1 F (7.NES (%lockMask ,CX)) 

THEN (MOV CX, %1ockMask 

)FI 

7.IF (%EQS (%operation , ADD)) 

THEN (MOV DX, 0 

)ELSE 

( 

7.1 F (7.EQS (7.operation , AND)) 

THEN (MOV DX, I 
)ELSE 
( 

7.1 F (7.EQS (%operat ion .OR)) 

THEN (MOV DX. 2 
) ELSE 
( 


7.1 F (7.EQS (%operation ,XCHG)) 
THEN (MOV OX. 3 
)ELSE (MOV OX, 4 
)FI 


)FI 


) FI 

InterruptCode, LOW MesaLockedOutSIVType 


(NotifyClientCondition (clientCondition)) 

( 

7.IF (7.NES (7.cl ientCondition .AX-BX-CX)) 

THEN ( 

MOV AX, WORD PTR 7»cl ientCondition 

MOV CX, WORD PTR %clientConditionf4] 

MOV BX, WORD PTR 7.cl 1entCondition[2] 

)FI 

DB InterruptCode, LOW NotifyClientConditionSIVType 

) 


(NotifyCondition (conditionPtr)) 

( 

%IF (%NES (7.conditionPtr ,BX)) 

THEN (MOV 8X, %conditionPtr 
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% * OE FINE 


%*DEFINE 


%*DEFIN£ 


%*DEFINE 


%*DEFINE 


%*DEFINE 


°/o*de:fine 


%*DEFINE 


IOPMacro.asm 


)FI 

DB InterruptCode, LOW NotifyCondltionSIVType 

) 

(NotifyHandlerCondition (handlerlD, conditionPtr)) 

( 

%IF (%NES (%handlerID,AX)) 

THEN (MOV AX, ChandlerID 

)FI 

%IF (%N£S (%condit1onPtr,BX)) 

THEN (MOV BX, %conditionPtr 

)FI 

DB InterruptCode, LOW NotlfyHandlerConditionSIVType 

) 

(ReadEEProm (eePromAddress, eePromVersion)) 

( 

%lf (%NE3 (%eePromVersion.AX)) 

THEN (MOV AX, %eePromVersion 

)FI 

%IF (%NES (%eePromAddress,BX)) 

THEN (MOV BX, %eePromAddress 

)FI 

DB InterruptCode, LOW ReadEEPromSIVType 

) 

(ReglsterPCEStartRoutine (location)) 

( 

%IF (%NES (%1ocation,CX-DX)) 

THEN ( 

MOV CX, OFFSET "^location 

MOV DX. CS 

) FI 

08 InterruptCode, LOW RegisterPCEStartRoutineSIVType 

) 

(Reset (deviceResetMask)) 

( 

%IF (%NES (%deviceResetMask.AX)) 

THEN (MOV AX, %deviceResetMask 

)FI 

DB InterruptCode, LOW ResetSIVType 

) 


(Restart (handlerlD, taskPtr, initLoc, initialStackPtr)) 

( 

°/oIF (%N£S (%handlerID,AX) ) 

THEN (MOV AX, %handlerID 

)FI 

“/GIF (%NES (%taskPtr,SI)) 

THEN (MOV SI, %taskPtr 

)FI 

%IF (%NES (%initLoc,CX-DX)) 

THEN ( 

MOV CX, OFFSET “/dnltLoc 

MOV DX, CS 

) FI 

%IF (%NES (%1nitialStackPtr,DI)) 

THEN (MOV 01, %initialStackPtr 

) FI 

08 InterruptCode, LOW RestartSIVType 

) 

(Subinterrupt (interruptName)) 

( 

08 InterruptCode, LOW %interruptName 

) 

(ThisTaskServIces (interruptName. badlnterruptProcLoc)) 

( 

%IF (%NES (%interruptName,BX)) 

THEN (MOV 8X, %1nterruptName 
) FI 

%IF (%NES (%badInterruptProcLoc,CX-DX)) 

THEN ( 

MOV CX, OFFSET %badlnterruptProcLoc 

MOV DX, CS 

) FI 

DB InterruptCode. LOW ThisTaskServicesSIVType 

) 

(WaltForCondition (conditionParms)) 

( 

%MATCH (conditionPtr.timeoutlnterval) (%conditionParms) 

%IF (%EQS (%timeoutInterval , noTimeout) OR %EQS ("Xtlmeoutlnterval ,%())) 
THEN (XOR AX, AX 

)ELSE 

( 

%IF (7.NES (%timeoutInterval ,AX)) 

THEN (MOV AX, %timeoutInterval 

) FI 
)FI 

%IF (%NES (%conditionPtr,BX)) 

THEN (MOV BX, %conditionPtr 

) FI 

DB InterruptCode, LOW WaitForConditionSlVType 

) 
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%*OEFINE 


(timeoutlnterval)) 


%*DEFINE 


% * D E FIN E 


;The following a 

%*DEFINE 


%*DEFINE 


%*DEFINE 


(WaltForlnterrupt 

( 

%IF (%EQS (%timeautlnterval.noTimeout) OR %EQS (%timeoutInterval,%())) 
THEN {XOR AX, AX 

)ELSE 

( 

%IF (%NES (%timeoutInterval.AX)) 

THEN (MOV AX, %timeoutInterval 

)FI 

)FI 

DB InterruptCode, LOW WaitForlnterruptSTVType 

) 

(WaltForSystem) 

( 

DB InterruptCode, LOW WaitForSystemSIVType 

) 

(WaltForTime (Interval)) 

( 

%IF (%NES (^Interval,AX)) 

THEN (MOV AX, ^interval 

)FI 

DB InterruptCode, LOW WaitForTImeSIVType 

) 


"e defined 


in RAM: 


(GetOptionsInterrupt(interruptMask, handlerlnterruptNumber)) 

( 

%IF (%NES (%1nterruptMask,DX)) 

THEN (MOV DX, %interruptMask 

) FI 

%IF (°XNES (^handlerlnterruptNumber ,CX)) 

THEN (MOV CX, %handlerInterruptNumber 

)FI 

DB InterruptCode, LOW GetOptionsInterruptSIVType 

) 

(ReleaseDMAChannel) 

( 

DB InterruptCode, LOW ReleaseDMAChannelSIVType 

) 

(WaltForDMAChanne!) 

( 

DB InterruptCode, LOW WaitForDMAChanneISIVType 

) 
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;Copyright (C) 1985 by Xerox Corporation. All rights reserved. 

stored as [Iri$]<WMicro>Dove>IOPStack.asm 
created on 15-May-85 15:47:00 

JPM .es 25-Jun-85 12:00:52 :Changed MinimumStackSize from 14 to L6 

JPM .es 15-May-85 15:47:00 :Creation 

;This file provides support for stack segment generation. 

;stack size constants (in words) 

MinimumStackSize EQU 16 ;for interrupt processing 

DefaultStackSIze EQU 40 ;a Hows several PUSHA, PUSH, CALL 

;stack allocation macro 


%*DEFINE 


(StackAllocation 

( 


PUBLIC 


(label , 
%label 


size)) 


%IF (%EQS (%size,%())) 

THEN ( DW DefaultStackSIze DUP %((?)) 

)ELSE ( DW %size DUP %((?)) 


)FI 

%1abel LABEL WORD 


) 



lOPStack.asm 
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;Copyr1ght (C) 1984, 1985 by Xerox Corporation. All rights reserved, 

IORegion locations for the bootstrap handler, 
stored as [Ir1s]<WM1cro>Dove>I0RRAMBt.asm 

last edited by: 


- 

RDH 

27-Jan-87 

10:53:06 

;Insert ending label. 

- 

RDH 

26-Jan-87 

16:31:44 

;Added stuff for cp to be handled from lop init block 

- 

kek 

6 -May~86 

18:12:25 

;added daisy stuff, 

- 

JAC 

10-Dec-85 

11:08:40 

;added bootMemoryPtr 

- 

JPM 

18-Jul-85 

8:26:14 

;Opie redesign conversion. 

- 

JMM 

17-Jun-85 

11:46:33 

;Removed doneWithGermFile and doneWithDBFile. 

- 

JPM 

5-Jun-85 

15:52:01 

•.Added doneWithGermFile and doneWithDBFile. 

- 

JMM 

21-Feb-85 

11:30:26 

;Misc. edits. 

- 

JMM 

20-Jan-85 

14:22:27 

;0pie 16 upgrade. 

- 

JMM 

30-Nov -84 

15:41:11 

;First release. 


NAME IORRAMBt 


$MOLIST 

SINCLUDE (lOPDefs.asm) 

$ INCLUDE (RAMBDefs.asm) 

$LI3T 


BootstrapIOR SEGMENT COMMON 

Assume DS:BootstrapIOR 


;EXPORTED variables: 


PUBLIC bootBufferFull, bootStrapTask, bootTask 

PUBLIC jumpTable, bootDevicelORSpace 

PUBLIC bootBufferEmpty.bootBufferPtr,bootFi1eChoice 

PUBLIC currents!ockSequence .currentBootBuffer 

PUBLIC fInlshedLoaderFileFetch, getBootFile, startOfBootBufferPool 

PUBLIC 1oaderVirtualMemoryLocation, bootMemoryPtr 

PUBLIC firstMicrocodeStartAddr, secondMicrocodeStartAddr 

PUBLIC firstMicrocodelnitAddr, secondMicrocodelnitAddr 

PUBLIC f1rstMicrocodeData, secondMicrocodeData, thirdMicrocodeData 

PUBLIC csBankConfiguration, CPType, WriteCSProc 

PUBLIC CPStartOrlnitProc, IncSIFarProc 

PUBLIC EndRAMBootstrapIOR 


bootTask 

bootStrapTask 

bootBufferFull 


jumpTable 


TaskContextBlock 

<> 

;Generic boot task in RAM. 

TaskContextBlock 

<> 

;ROM boot task -> RAM*Bt task 

Condition 

<> 

:Condit1on variable for 



;handler - bootstrap 



; coordination. 

BootJumpTable 

<> 

:Use to do Indirect jumps. 


bootDevicelORSpace 


D8 200 DUP (?) 


This section is used by the 
device boot heads for whatever 
needs they may have. I.e. One 
could define device specific 
structures in the device boot 
head then load a register with 
"deviceSpecificArea" and use 
.extension to access the needed 
variables. 


everything above is identical with IORROMBt.asm 


bootBufferEmpty 

Condition 

<> 


finishedLoaderF11eFetch 

Condition 

<> 


getBootFile 

Condition 

<> 


bootFileChoice 

DB 

6 DUP 

(?) 

For Ethernet, this would 
contain the boot file number 
of the file we want. For disk, 
this would . . . 

startOf8ootBufferPool 

DW 

? 


pointer to (n) linked buffers, 
its value changes depending on 
whether we are doing a diagnosti 
boot or a normal boot (i.e. a 
diagnostic boot requires more 
room to load into) 

bootBufferPtr 

DW 

? 


Pointer to load area for booting 

currentBootBuf fer 

DW 

? 


For keeping track of buffer to 
process. 
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currentBlockSequence 


DW 


? 


;For keeping track of where we are 
;at in processing a boot buffer. 


;The variables below are initialized at main memory set-up for the particular religion 
;and happens during an emulator load. 


ToaderVirtualMemoryLocation DD 

bootMemoryPtr DW 


7 

7 


;This is an SEG:INDEX pair of where the 
;loader goes. 


;for Daisy, addresses of first and second microinstruction to be started, 
firstMicrocodeStartAddr DW ? 

secondMIcrocodeStartAddr DW ? 


;for Daisy, addresses of first 
firstMicrocodelnitAddr 
secondMicrocodelnitAddr 


and second microinstruction 
DW ? 

DW ? 


to be 


inited. 


;for Daisy, first, second 
f1rstMIcrocodeData 
secondMicrocodeData 
thirdMicrocodeData 

csBankConfiguration DB ? 

; 10H, 20H, 30H, 40H => 4K, 8K, 12K. 16K etc. 

CPType DB ? ;20H ~> Daisy. 60H => Daybreak 


. and third microinstruction data. 
DW ? 

DW ? 

DW ? 


;Offsets and code segments to be called from RAMBoot.asm 

WriteCSProc DW 2 DUP (?) ;Set up by InitCPSpecific in DoveCP.asm 

CPStartOrlnitProc DW 2 OUP (?) 


;Offsets and code segments to be called from here back into RAMBoot.asm 
IncSIFarProc DW 2 DUP (?) ;Set up by RAMBoot.asm 

EndRAMBootstrap £0R LABEL FAR 


8ootstrapIOR ENDS 


END 


IORFiAMBt. asm 
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iCopyrlght (C) 1984, 1985 by Xerox Corporation. All rights reserved. 

lORegion locations for the bootstrap handler, 
stored as IORROMBt.asm 

last edited by: 


-- 

RDH 

14-Sep-85 

9:46:10 

-- 

RDH 

l3-Sep-85 

20:40:51 

-- 

RDH 

lO-Sep-85 

20:05:53 

-- 

RDH 

10-Sep-85 

20:05:53 

-- 

JAC 

29-Aug-85 

9:29:12 

-- 

RDH 


-- 

RDH 



-- 

JPM 



-- 

J PM 



-- 

JMM 



-- 

JMM 



-- 

BKI/JMM 




name; 


IORROMBt 


Added bigTimeOut, 1ittleTimeout. and allowTimeout to make longer (35 sec) timeout period work. 
Added displayStartOffset and displayStartSegment for maint panel visibility. 

Commented out currentCursor since there is no more mouse tracking, 
added OverlayLength 


added End8ootstrapIOR 
22-Aug-85 12:35:47 
14-Aug-85 15:08:08 
18-Jul-85 8:26:07 

11-Jul-85 8:49:13 

4-Apr-85 20:30:35 
20-Jan-85 14:23:17 
24-Oct-84 16:18:41 


;Overlay bootDevicelORSpace 
;Folded in UI stuff. 
;Removed idledBootTasks. 
:0pie redesign conversion. 
;Misc. edits. 

;0pie 16 upgrade. 

;First release. 


with icon data strucs. 


SNOLIST 

$INCLUDE (IOPDefs.asm) 

$INCLUDE (ROMBOefs.asm) 

$ LI ST 


BootStrapIOR SEGMENT COMMON 

Assume DS:BootStrapIOR 


;EXPORTED variables: 


PUBLIC 

bootBufferFul1, bootStrapTask. bootTask 

PUBLIC 

jumpTable, bootDevicelORSpace 

PUBLIC 

bootDevicelCON, displaySegment, displayOffset 

:PUBLIC 

currentCursor 

PUBLIC 

ICONsBottomEdge, ICONsTopEdge 

PUBLIC 

displayWidthlnBytes, selectedICON 

PUBLIC 

displayStartOffset, displayStartSegment 

PUBLIC 

bigTimeOut 

PUBLIC 

11ttleTimeOut 

PUBLIC 

allowTimeout 

PUBLIC 

EndBootstrapIOR 

PUBLIC 

OverlayLength 


bootTask 
bootstrap Task 
bootBufferFul1 


jumpTable 


TaskContextBlock <> 
TaskContextBlock <> 
Condition <> 


BootJumpTable <> 


Generic boot task in RAM. 

ROM boot task -> RAM*Bt task. 
Condition variable for 
handler - bootstrap 
coordination. 

Use to do indirect jumps. 


bootDevicelORSpace 


DB 200 DUP (?) 


This section is used by the 
device boot heads for whatever 
needs they may have. i.e. One 
could define device specific 
structures in the device boot 
head then load a register with 
"deviceSpecificArea" and use 
.extension to access the needed 
variables. 


everything above Is identical with IORRAMBt.asm 


ORG OFFSET bootDevicelORSpace ;0verlay since icon data structures 

;wi11 not be used once boot device is 
;determined. 


bootDevicelCON 

EQU $ 


bootDevicellCON 

ICONDataStructure 

<> 

boot.Device2ICON 

ICONDataStructure 

<> 

bootDevice3ICON 

ICONDataStructure 

<> 

boot.Device4IC0N 

ICONDataStructure 

<> 

boot,Device5ICON 

ICONDataStructure 

<> 

boot.Device6ICON 

ICONDataStructure 

<> 

baotDevice7ICON 

ICONDataStructure 

<> 

IORROMBt.asm 
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bootDevice8ICON 

bootDevice9IC0N 

bootDevicelOICON 


displa.yWidthlnBytes 

displaySegment 

dlsplayOffset 

selectedICON 

flrstlCONOffset 

ICONsBottomEdge 

ICONsTopEdge 

displayStartOffset 

displayStartSegment 

big TimeOut 

1ittl eTimeOut 

al1owTimeout 

; currentCursor 

EndBootstrapIOR 

Over!ayLength 

BootstraptOR 


ICONDataStructure <> 

ICONDataStructure <> 

ICONDataStructure <> 


DW 
DW 
DW 
DW 
DW 
DW 
DW 
DW 
DW 
DB 
DW 
DB 

cursorPosi 
EQU $ 

EQU $ 


tlon 


;These are used to remember where the 
; icons go in display memory. 


;These are used to remember the beginning 
; of the display. 

;Used to count down seconds in timeout. 

;llsed to compare to interval timer to see if one second has passed. 
;flag to control if default booting will occur. 

<> 


bootDevIcelORSpace 


ENDS 


END 


IORROMBt.asm 
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:Copyright (C) 1984 by Xerox Corporation. All rights reserved. 


stored as [Idun]<WDLion>Dove>QueDefs.asm 
created on 20-Aug-84 12:00:16 

;- - last edited by: 

JoM .es 20-Aug-84 12:00:16 :Created. 

Queue Block Structure 


QueueB'lock 

STRUC 



queueHead 

DW 

2 OUP 

(?) 

queueTall 

DW 

2 OUP 

(?) 

queueNext 

DW 

2 DUP 

(?) 

QueueB'lock 

ENDS 




OpieAddress for first item on queue, or 
OpieAddress for last item on queue, or 0 
OpieAddress for next item to process, or 


0 if NIL 
if NIL 
0 if NIL 


QueDef s.asm 
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;Copyright (C) 1984 by Xerox Corporation. All rights reserved. 


-- stored as [Idun]<WOLion>Oove>QueMacro.asm 
-- created on 20-Aug-84 16:12:01 

-- last edited by: 

Fixed parentheses mismatch. 

Opie redesign. 

Substituted generalMapRegister for systemMapNo. 

Replaced constant offsets by OpieAddress field offsets. 
Revised for new EstablishlOPAccess macro. 

Added JumplfMesalOCBNextNil and JumpIfQueueNextNil. 


J rM 

J PM 
JPM 
J PM 
JPM 
JPM 


.es 

.es 


^t>-Jun-ao L-i : io : 40 
14-May-85 14:34:41 
29-Oct-84 8:41:32 
26-Oct-84 16:17:48 
2-Oct-84 17:43:09 
l2-Seo-84 15:16:59 


These macros define queue operations used in the IOP. 

Note: clients should call these macros only at system level. 


;— Definition of STRUC QueueBlock is In QueDefs.asm 
Definition of STRUC OpieAddress is in lOPDefs.asm 
Additional macros referenced herein are in IOPMacro.asm 

AdvanceMesaI0C8 advances to the next IOCB in a Mesa-maintained chain. 

(Note that only one word of the link is used, and locking must be done) 
mappedOrNot = "mapped” iff £S:DI points to the current IOCB, and 
at end of macro, ES:DI points to that IOCB and (ZF) is 1 iff next - NIL 

7.* DEFINE (AdvanceMesalOCB (iocbNext, linkOffset, lockMask, mappedOrNot)) 

LOCAL Lb10 Lb11 

( %IF (%NES (mapped,%mappedOrNot)) 

THEN (%EstablishlOPAccess (generalMapRegister,%iocbNext)) FI 
MOV AX, ES: [DI] .7.1 inkOffset.OpieAddressLow 

MOV BX, OFFSET 7iocbNext.OpieAddressLow 

MOV CX. 7.1ockMask 

%LblO: %MesaLockedOut (MOV,BX,AX,CX) 

OR AX, AX 

JNZ %Lbl1 

MOV AX, ES:[DI] .7.1 inkOffset.OpieAddressLow 

OR AX, AX 

JNZ %Lbl0 

%Lbl1: 

) 

AdvanceQueue advances to the next IOCB in an IOP-maintained chain. 
mappedOrNot = "mapped" iff ES:DI points to the current IOCB, and 
at end of macro, ES:0I points to that IOCB and (ZF) is 1 iff next = NIL 

%*DEFINE (AdvanceQueue (queueBlock, linkOffset, mappedOrNot)) 

( 7.IF (%NES (mapped ,%mappedOrNot)) 

THEN (%EstablishlOPAccess (generalMapRegister,%queueBlock.queueNext)) FI 
MOV DX, ES:[DI].71InkOffset.OpieAddressLow 

MOV %queueBlock.queueNext.OpieAddressLow, DX 

MOV CX, ES:[DI].%1inkOffset.OpieAddressHigh 

MOV %queueBlock.queueNext.OpieAddressHigh, CX 

OR CH. CH 

) 


;DeQueue removes the first IOCB from an lOP-maintained chain. 
:(caller must ensure that queueBlock.queueHead is not NIL) 


%*DEFINE 


(DeQueue 

LOCAL LblO 
( %IF 

THEN 


7. IF 

THEN 


%LblO: 

) 


(queueBlock, linkOffset, preserveESOrNot)) 

(%EQS (^preserveESOrNot.preserveES)) 

(PUSH ES)FI 

%Estab!ishlOPAccess (generalMapRegister,7.queueBlock .queueHead) 

MOV DX. ES:[DI] .7.1 inkOffset.OpieAddressLow 

MOV CX, ES:[DI] .7.1 inkOffset.OpieAddressHigh 

(%EQS (%preserveESOrNot.preserveES)) 

(POP ES)FI 

MOV ^queueBlock .queueHead .OpieAddressLow, DX 

MOV ^.queueBl ock .queueHead .Op IeAddressHigh , CX 

CMP CH, nilOpieAddress 

JNZ %Lb10 

MOV 'XqueueBlock.queueTail .OpieAddressLow, DX 

MOV %queueBlock.queueFai1.OpieAddressHigh, CX 


;-- EnQueue adds an IOCB to the end of an IOP-maintained chain. 

CX:0X contains the OpieAddress of the IOCB to be added 

%*DEFINE (EnQueue (queueBlock, linkOffset, preserveESOrNot)) 

LOCAL LblO Lbl1 Lbl2 


CMP 

7.queueBlock .queueHead .OpieAddressType , ni lOp IeAddress 

JNZ 

’/.LblO 

MOV 

%queueBlock.queueHead.OpieAddressLow, DX 

MOV 

%queueBlock.queueHead.OpieAddressHigh, CX 

JMP 

SHORT 7.Lb11 

%LblO: 


(7.EQS 

(%preserveESOrNot,preserveES)) 

THEN (PUSH 

ES)FI 


PUSH CX 
PUSH DX 

%E stab! ishlOPAccess (gene ralMapRegister ,7.queueB lock, queue Tail) 


QueMacro.asm 
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POP 

POP 

MOV 

MOV 

%IF (%EQS 

THEN (POP 

%Lbll: MOV 
MOV 
CMP 
JNZ 
MOV 
MOV 

%Lbl2: 

) 


DX 

CX 

ES:[DI] .%] inkOffset,OpleAddressLow, DX 
E$:[DI].%11nkOffset.OpieAddressHigh, CX 
(7.preserveES0rNot.preserveES)) 

ES) FI 

%queueBlock.queueTai1.OpieAddressLow, DX 
"/.queueBlock.queueTail.OpieAddressHigh, CX 
%queueB1ock.queueNext.OpieAddressType, nilOpieAdd ress 
%Lbl 2 

%queue8lock.queueNext.OpieAddressLow, DX 
%queueBlock.queueNext.OpieAddressHigh, CX 


JumplfMesalOCBNextNil does a jump if the queueNext field Is NIL. 
Note: for Mesa queues, "NIL" means the low-order word is 0. 


%*DEFINE 


(JumplfMesalOCBNextNil 
( CMP 

JZ 


) 


(iocbNext, jumpLabel)) 
%1ocbNext.OpieAddressLow, 0 
"/.jumpLabel 


JumpIfQueueNextNil does a jump if the queueNext field is NIL. 

Note: for IOP queues, "NIL" means the high-order byte is nilOpieAddress. 


%*DEFINE 


(JumpIfQueueNextNil 
( CMP 

JZ 

) 


(queueBlock. jumpLabel)) 

%queueBl ock.queueNext.OpieAddressType. ni1OpieAddress 
"/.jumpLabel 


QueMacro.asm 


26-Jun-85 13:13:50 POT 



;Copy right (C) 1984, 1985, 1987 by Xerox Corporation. All rights reserved. 


IORegion locations for the boot handler, 
stored as [Iris]<WM1cro>Dove>RAMBDefs.asm 


last edited by: 


-- 

J PM 

ll-May-87 

9:05:32 


RDH 

26-Jan-87 

19:38:32 

-- 

KEK 

7-May-86 

9:46:14 

-- 

RDH 

24-0ct-86 

16:56:16 

-- 

kek 

4-Sep-85 

14:28:38 

-- 

JPM 

18-Jul-85 

12:27:26 

— 

JMM 

2-Jul-85 

17:38:06 

-- 

JPM 

22-May-85 

9:19:21 

-- 

JMM 

22-Ap r-85 

12:06:08 

-- 

JMM 

4-Apr-85 

10:40:07 

-- 

JMM 

28-Jan-85 

18:28:27 

-- 

JMM 

23-Jan-85 

15:04:01 

-- 

BKI/JMM 

9-Dec-84 

20:03:43 


Add new MP codes. 

Add CSWordByteSize and fourKEEPromFormat. 
update daisy constants. 

Add device types defs. 
mp code definitions 

Add bootDataBegins and uncomment BootJumpTable STRUC. 
Increased normal load area. 

Diagnostic boot changes. 

Adjusted load area. 

Add macro section. 

Increase buffer size. 

First release. 


; NAME 


RAMBDefs 


;Constants for STRUC definitions. 


;Most things require a page (512 bytes) except Ethernet which has some overhead. 
;(one page + packet overhead + simple data overhead) 


maximumBootBufferSize 

EQU 

512+44+12 

BootBuffer 

STRUC 




nextBootBuffe r 

DW 

? 


;We have to abe able to do the following 

bootDataStart 

DW 

? 


;SI+[BX].bootDataStart and have [BX][SI] 

bootDataEnd 

DW 

? 


:point to data. Likewise for "bootDataEnd 

bootData 

DB 

maximumBootBufferSize OUP(?) 

BootBuffer 

ENDS 




bootDataBegins 

EQU 

bootData 

-nextBootBuffer 

8ootJumpTab1e 

STRUC 




startRAMOpie 

DW 

? 


;An IOP Start block will result in an IOP 

startRAMOpieCS 

DW 

? 


;address being saved here for later entry 

iOpEntry 

DW 

? 



IopEntryCS 

DW 

■? 



processBootBlock 

DW 

? 



BootJumpTable 

ENDS 




;BootTimeVariables 

STRUC 



;located in RQMBDefs.asm 

-.device 

ow 

? 


:1-Disk, 2-Ethernet, 3-F1oppy, 4-RS232C. 

;mode 

DW 

? 


;0-Normal, l-Fast boot. 

;showUserInterface 

DW 

? 


:0-yes . # 0 -no. 

jbootRetryCount 

DW 

? 


;initially 0, Incremented per failure 

;re incarnationFlag 

DW 

? 


;For task reinitialization - 0 => tasks 
:to use local RAM otherwise main memory. 

;emulatorlD 

DW 

3 

DUP(?) 

ilnitially 0, updated by boot executive. 

;loaderlD 

DW 

3 

DUP(?) 

;Initially 0, updated by boot executive. 

;diagnosticsType 

DW 

? 


initialized at boot-time. 0 short 

idiagnostics - user has set EEPROM to 
lindicate desire for a diagnostics boot. 
;#0=> long diagnostics boot - user has 
imanually requested diagnostics at boot 





;time! 

;BootTimeVariables 

ENOS 




:Boot types: 





normal 

EQU 

0 



diagnostic 

EQU 

1 



;Device types: 





disk 

EQU 

l 
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floppy 

EQU 

2 

ethernet 

EQU 

3 

experimental 

EQU 

4 

rs232C 

EQU 

4 


Booting error numbers: 


bootingError EQU -1 
unKnownBootBlock EQU 0303H 
noRAMStartAddress EQU 0404H 

;Other constants: 


EOF 

highByteMask 
lowByteMask 
oneBit 
onePage 

diagnosticsLoadAreaSize 
normalLoadAreaSIze 
loaderTimeout 


;Control Store constants 

fourKEEPromFormat 

CSWordByteSize 

; Daybreak; 

daybreakBankRegister 

daybreakCSPortMask 

nextCSByte 


EQU 

OFFB 


EQU 

OFFOOH 


EQU 

OFFH 


EQU 

1 


EQU 

512 

;In bytes 

EQU 

2000H 


EQU 

2000H 

;Too big! 

EQU 

04H 



EQU 

10H 

EQU 

6 


EQU 

OEOOOH 

EQU 

08000H 

EQU 

01000H 


:Daisy: 


BytesInShiftReglster 
BytesPerMicroInstruction 
;Data From control store is port 
SiriusPort EQU OBOH 


Ram 

EQU 

8000H 

NCSShift 

EQU 

4000H 

CSShift 

EQU 

0 

CSDOe 

EQU 

2000H 

SData 

EQU 

1000H 

SClock 

EQU 

800H 

NHalt 

EQU 

200H 

IOPInt 

EQU 

1Q0H 

CSDataBit 

EQU 

2000H 


EQU 6 
EQU 6 

080H bit 13 l.e. 

:The port for controlling 
;bit 7: RAMWrEnable 
:bit 6: CSShift' 

;bit 5: CSDOe 
;bit 4: shift data 
;b1t 3: ShiftClk 
;bit 2: Halt' 

;bit l: ResetSChip' 

;bit 0: lOPIntSChip 


the Sirius 


chip 


Daisy & Daybreak: 


Convenience macros: 


%*Define (MultiplyByTwo (register)) 
(ROL "/.register, 1) 


Maintenance Panel Codes: 


mpStartBooting 

EQU 

0100D 

mpFetchlnitial 

EQU 

0149D 

mpRunlnitial 

EQU 

0150D 

mplnitialError 

EQU 

0151D 

mpFetchMesaOove 

EQU 

0199D 

mpRunMesaDove 

EQU 

0200D 

mpMesaOoveError 

EQU 

020 ID 

mpSDDReadError 

EQU 

0209D 

mpSDDSealError 

EQU 

0211D 

mpSDDVrsnError 

EQU 

0212D 

mpSDDCksmError 

EQU 

0213D 

mpRunGerm 

EQU 

050 ID 

mpFloppyCleaning 

EQU 


0077D 
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SMOD186 

SPAGELENGTH (72) 

SPAGEWIDTH (136) 

;Copyright (C) 1984, 1985, 1986 by Xerox Corporation. All rights reserved. 

stored as RAMBoot.asm 
created on 19-Jul-84 13:20:18 

last edited by: 

RDH 19-Jan-87 10:12:01 ;Remove CP specific stuff to iop inlt block. 

;Added EXTRNs: WriteCSProc CPStartOrlnitProc IncSIFarProc. 

;Added init of IncSIFarProc IncSIFarProc+-2. Added IncSIFar. 

;Changed call to DumpCSBlock in Checksum to 2 calls to IncrementSI 
;At ReadOffset+2 change CALL LoadCXFromBootBuf to CALL LoadAXFromBootBuf; MOV CX, AX 
;Commented out all of LoadCXFromBootBuf. 

JPM 29-Jul-86 15:57:30 ;Activate InitializeCP code (uncomment code, add calls to Start/StopCP, 

enable/clear/disable interrupt). 

RDH 22-Jan-86 12:06:22 ;Adjust code for cs config of "any-type", and fix buglet in InitiallzeiOr. 

RDH 17-Jan-86 12:06:08 ;Create and use procs 

; LoadCXFromBootBuf and LoadAXFromBootBuf to save space. 

; Comment out useless code for doing Daybreak cp inits and starts. 

: Alter IncrementSI, ProcessEmulatorFile , and ProcessMultipleDBsFi1e 
; to use new proc ReloadBuffer created from part of ProcessEmulatorFile. 

RDH l4-Jan-86 15:25:14 ;Add code for handling fb's for various control store configurations, and add labels near 

beginning of all proc's for debugging ease. 

rdh 13-Jan-88 13:39:34 ;Change AX to AL in setting control store bank register for 8K. 

RDH 9-Jan-86 11:45:38 :Add stuff for handling fb files for bank configs not on the machine. 

J-- JAC 6-Jan-86 10:00:59 :comment out rest of Daisy stuff because the addns to initial kill ether booting 

diagnostics , . 

JAC lO-Dec-85 11:04:03 ;add checking in WritelOPMemory, StartlOP and Ini tial izelOP for mam memory 

RDH 28-Oct-85 12:33:27 ;Add code to fix etherbooting of diagnostics by sending an error packet when EOF block is 

found and it is an ethernet diagnostic boot. Commented out some Daisy code to make room. 

jpm 2G-Sep-85 9:29:24 ;Move boot buffer allocation to device-specific code, 

bki 6-Sep-85 11:52:40 ;change some JMP's to SHORT'S, 

kek 4-Sep-85 14:58:06 ;mp codes 

jpm 6-Aug-85 16:25:43 ;Remove extra POP in ProcessLoaderFile. 

j-- JPM l-Aug-85 15:04:33 ;Fix bug in OutOfLoadSpace. 

JPM 18-Jul-85 15:17:48 ;Opie redesign conversion. 

JMM 20-Jun-85 14:55:53 -.New IOPLRAM.asm upgrade. 

JMM 17-Jun-85 12:25:18 ;Deleted doneWithDBFile and doneWithGermFHe and restored previous protocol. 

JPM 6-Jun-85 8:19:41 :Switch to word offset in multiple db files; share buffer loading code. 

j PM 5-Jun-85 15:48:02 ; F i x byte-swap bug in MultipleDBs; use doneWithDBFile and doneWithGermFile for control 

flow. 

JPM 30-May~85 15:01:34 ;Fixed bug in StartlOP. 

JPM 22-May-85 10:11:58 ;Revised for overlay booting. 

JMM l2-Apr-85 18:44:28 :Debugging additions. 

JMM 31-Jan-85 11:43:32 ;Diagnostics handling. 

JMM l5-Jan-85 16:41:11 ; First release. 

NAME RAMBoot 


SNOLIST 
SINCLUDE 
SINCLUDE 
$INCLUDE 
SINCLUDE 
$ INCLUDE 
$INCLUDE 
JINCLUDE 
; $INCLUDE 
; SINCLUDE 
$LIST 


%*DEFINE (ByteSwap (wordToSwap)) 

(%wordToSwap SHL 8 OR %wordToSwap SHR 8) 


%*DEFINE(Handler(name.Id,initProcAction)) ( 

PUBLIC %name%(HandlerlD) 

%name%(HandlerID) EQU %id 

) 

%HandlersLinked 

EXTR.N mesaProcessorlnterrupt :A8S 




I0PELocal RAM SEGMENT AT 0 


; from IOPLRAM.asm: 


EXTRN 

EXTRN 

EXTRN 

EXTRN 

EXTRN 

EXTRN 

EXTRN 


bootOverlayReentry: WORD 
bootType: BYTE 
device: WORD 
skipUserlnterface: BYTE 
bootOverlayRequest: WORD 
startOfBootBufferSpace: WORD 
endOfBootBufferSpace: WORD 


(EthHdFce.asm) 

(HardDefs.asm) 

(IOPDef s.asm) 

(IOPMacro.asm) 

(RAMBDefs.asm) 

(EthBDefs.asm) 

(Handlers.asm) ;to resolve handler IDs 
(CSBankDf.asm) 

(RAMEEP.asm) 
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EXTRN 


resetRegData: WORD 


IOPELocalRAM ENDS 




;Imported Variables: 


;from lORMaint.asm: 

Ma i ntPfinel IOR SEGMENT COMMON 


EXTRN 

EXTRN 


maintPanelCode: WORD 
maintPanelChanged: Condition 


MaintPanelIOR 


ENDS 


-.from lORRAMBt .asm: 


BootStrapIOR 


SEGMENT COMMON 


EXTRN 

EXTRN 

EXTRN 

EXTRN 

EXTRN 

EXTRN 

;EXTRN 

EXTRN 

EXTRN 

EXTRN 

EXTRN 

EXTRN 

EXTRN 

EXTRN 

EXTRN 


bootTask: TaskContextBlock 
bootBufferPtr :WORD 

bootBufferEmpty :Condition, bootBufferFul1 :Condit1on 

finishedLoaderFileFetch Condition, getBootFile :Condition 

bootFileChoice :WORD 

currentBootBuffer :WORD 

currentBlockSequence :WORD 

jumpTable :BootJumpTable 

startOfBootBufferPool :WORD 

1oaderVirtualMemoryLocation :DWORD 

BootDevicelORSpace :RamEtherBootContext 

bootMemoryPtr: WORD 

WriteCSProc: WORD 

CPStartOrlnitProc: WORD 

IncSIFarProc: WORD 


BootStrapIOR ENDS 


. * * * 




IOPEInRAM SEGMENT PUBLIC 

ASSUME CS:IOPEInRAM 
ASSUME DS:BootstrapIOR 


PUBLIC EndOfInitial 

PUBLIC BootTasklnit 

PUBLIC DisplayMPCode 

;Needed for etherbooting diagnostics. This will cause a link time warning, 
;Unresolved External when building diskboot.Ink and flpyboot.1nk. 

EXTRN TransmitFrame: NEAR 

bootBufferSize DW SIZE BootBuffer 


Dove Boot Blocks: 


BootFile => BootBlock | BootBlock . BootFile 
BootBlock => Type . Address . DataLength . Data 

Type => CP . Command | IOP . Command | Checksum | MultipleFiles | EOF 

Command = > Operation . MachineType . MemorySection , BankConfiguration . Bit . Byte 

Operation => Initialize | Start | writeData 

CP => i 

IOP => 0 

Initialize => 00 
Start => 01 
writeData => 10 

MachineType => Daisy | DayBreak 
Daisy => 0 
DayBreak => 1 

MemorySection => LocalRam | MainMemory 
LocalRam => 0 
MainMemory => 1 

BankConfiguration => fourK | eightK ( twelveK | sixteenK 

fourK => 00 

eightK => 01 

twelveK => 10 

sixteenK => 11 

Checksum => 1110 . 0000 . 0000 . 0000 
MultipleFiles => 1111 . 1111 . DBFileCount . FileOffset 
FileOffset => FileOffset . FileOffset | FileOffset 
Address => DoveCPAddress | DovelOPAddress 
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;DoveCPAddress => CPAddress | BankValue . CPAddress | CPAddress . CPNextAddress 
;BankValue => DaybreakBankValue | DaisyBankValue 

;OaybreakBankValue => Daybreak8ank0 | DaybreakBankl | DaybreakBank2 | Daybreak8ank3 
:DaisyBankValue = > DaisyBankO [ OaisyBankl | DaisyBank2 | DaisyBank3 
;CPNextAddress => CPAddress 
;CPAddress => m = {0,1,2, . . .2+16-1} 

;DoveIOPAddress => AddressSegment . AddressOffset 
;DataLength => j = {0,1,2, . . .2tl6-l} 

; DBFilaCount => k = {1,2, . . .254} 

; Fi1eOff set => 1 = {0,1,2, . . .2+16-1} 

;DaybroakBankO => NullByte . 0000 . 0000 


OaybreakBankl 

=> NullByte , 

0011 . 0000 

DaybreakBank2 

=> NullByte . 

0101 . 0000 

DaybreakBank3 

=> NullByte . 

1001 . 0000 

DaisyBankO => 

0001 . 0000 . 

NulIByte 

OaisyBankl => 

0010 . 0000 . 

NullByte 

Daisy8ank2 => 

0100 . 0000 . 

NullByte 

Daisy8ank3 => 

1000 . 0000 . 

NullByte 

Data > CPData 

1 IOPData 

CPData => (Word . Word . Word)* 

IGPData *> Byte* 


AddressSegment 

=> n = {0,1,2 

, . . .2tl6-l} 

AddressOffset 

= > n = {0,1,2, 

. . .2+16-1} 

EOF => 1111 . 

1111 . lilt . 

mi 

Word => Byte . 

Byte 


Byte => Nibble 

. Nibble 


Nul1 Byte -> 0000 . 0000 


Nibble => (0+l)(0+l)(0+l)(0+ 
Bit => (0+1) 

i) 

Hex 

Binary 


Ox 

0000,xxxx 

IOP Daisy Initialize 

lx 

0001.xxxx 

IOP Daybreak Initialize 

2x 

0010.xxxx 

IOP Daisy Start 

3x 

0011.xxxx 

IOP Daybreak Start 

4x 

0100.xxxx 

IOP Daisy Write 

5x 

0101.xxxx 

IOP Daybreak Write 

6x 

0110.xxxx 

IOP Daisy Unknown 

7x 

0111.xxxx 

IOP Daybreak Unknown 

8x 

1000.xxxx 

CP Daisy Initialize 

9x 

1001.xxxx 

CP Daybreak Initialize 

Ax 

1010.xxxx 

CP Daisy Start 

Bx 

1011.xxxx 

CP Daybreak Start 

Cx 

1100,xxxx 

CP Daisy Write 

Dx 

1101.xxxx 

CP Daybreak Write 

Ex 

1110.xxxx 

Checksum 

Fx 

ini. xxxx 

EOF or MultipieDB's 


-- Boot task initialization: 

- This task communicates with the device specific task to load in 

- t h e M esa emulator file and RAM based opie and to also prepare the: 

- virtual memory map, Germ variables and load the Germ. 


startOfBootBufferSpace = This is supplied by Opie and 
points to the beginning of a huge buffer that lies 
right after STACK space but right before local RAM 
IORegion. Tnitial updates it so that it points just 
beyond *Initial. Boot then adjusts it so that there is| 
loadable space between *Initial and the beginning of 
buffer. It is up to Boot task to divide this buffer 
into a pool of buffers to be used in conjuction 
with RAM*Bt.asm to load files. Any Opie files must be | 
loaded last since we start loading RAM based Opie in 
low RAM going upwards. 


BootTasklnit PROC NEAR 

BeginBootTask: %’ThisTaskServices (mesaProcessorInterrupt,BadMesaInterrupt) 

;This will be done in the CP specific code that is loaded from 
; the last IOP Init block before the cp oriented blocks. 

;Recall that any boot block of the type CP- 
;Initialize causes the CP to be started which 
;in turn is expected to issue an interrupt when 
;it is done initializing the CP. This interrupt 
iservlcing will be taken over by Mesa processor 
;task when RAM based opie starts. In fact on 
; loading CP code, CP is not started even though 
;its start address is progrmmed into it, rather 
: it is left to Mesa processor task to start CP 
isince by then all of Opie should be ready. 

MOV AX, IOPELocalRAM ;We will occassionaily refer to variables 
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MOV 

ASSUME 

MOV 

MOV 

MOV 

AOD 

AND 

MOV 

MOV 

MOV 

MOV 

MOV 


ES, AX :in IOP low memory (which will cover all of 

ES:IOPELocalRAM ;boot buffer and load space), 

AX, startOfBootBufferPool ;Pick up buffer(s) supplied 
currentBootBuffer, AX ;by device-specific code. 

AX. startOfBootBufferSpace ;Also get boot area address, 

AX, LowNibbleMask ;adjust it so that it Is 

AX, NOT(LowNibbleMask) ;at a "paragraph” boundary and then 
;save it for loading IOP code 
bootBufferPtr, AX ;into later. 

jumpTable.startRAMOpie, OFFSET NoRAMOpieEntryPoint 
jumpTable.startRAMOpieCS. CS ;Ju$t in case we never get a 

;RAMOpie entry IOPStart block. 
IncSIFarProc, OFFSET IncSIFar initialize point for CP 
IncSIFarProc+2, CS ; specific code to call 

; to get IncrementSI. 


%NotifyCond1tion (OFFSET getBootFile) 


;DaisyCPConditioning: 


DaybreakCPConditioning: 


tching 

MesaDove 


MOV 

AX, mpFetchMesaDove 


CALL 

DlsplayMPCode 


; IN 

AX, machinelDPort 

;The Mesa processor should be halted 

; AND 

AX, machinelDMask 

ibefore we do anything to it. 

; CMP 

AX, Daisy 

ibefore we do anything to it. 

: JNE 

DaybreakCPConditioning 


CALL 

DaisyCPHal t 


; JMP 

SHORT ProcessEmulatorFile 


CALL DaybreakCPHalt 


CLI 


;to protect reset register 

MOV 

AX, resetRegData 


AND 

AX, NOT resetMesaProcessor 

OUT 

WriteResetReg, AX 


CALL 

DaybreakCPStart 


OR 

resetRegData, resetMesaProcessor 

MOV 

AX, resetRegData 


OUT 

WriteResetReg, AX 


CALL 

DaybreakCPHalt 


STI 


idone with reset register 


;Put the number of extra control store banks in the 
; variable, csBankConfiguration. 

CALL GetCSBankConfig 


JMP SHORT ProcessEmulatorFile 
BootTasklnit ENDP 


-- Boot file processing: 

- Assume parameter locations upon entry into this procedure 

- are as follows: 


currentBootBuffer = pointer to current boot buffer. 
At this point, boot block type is as follows: 

'zxxx' where *x' is a don't care bit and 
' z' is the bit we are testing for. Except 
initially we do test all of 'zxxx' for EOF 
or MultipleDBfile. 


BX = currentBootBuffer 
Sit = BootBlock.Type 


AH = xxxO - remaining bits to be tested. 
BX = pointer to the buffer to process. 

SI = BootBlock.Type 


ProcessEmulatorFile 

PROC 

NEAR 


CALL 

WaitForFullBuffer 

StartSequence: 

CALL 

LoadAXFromBootBufLateEntry ;Get the boot block type 

CouldBeCPorlOPType: 

SHL 

AH, oneBit 


JC 

ItsaCPBlockType 


MOV 

jumpTable.processBootBlock, OFFSET ProcessIOPBlock 


JMP 

SHORT BootBlockldentified 

ItsaCPBlockType: 

MOV 

jumpTable.processBootBlock, OFFSET ProcessCPBlock 

BootBlockIdentified: 

CALL 

WORD PTR jumpTable.processBootBlock 
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CMP SI, ES: [BX].bootOataEnd 

JLE StartSequence 

CALL PrepareToFetchBuffer 

JMP StartSequence 


ProcessEmulatorFIle ENDP 


-- ReloadBuffer: 

- Assume parameter locations upon entry into this procedure 

- are as follows: 


ReloadBuffer PROC 

NEAR 



WaitForFu11 Buffer: 

PUSHA 

%WaitForCondition (OFFSET bootBufferFul1 
POPA 

, noTimeout) 

FetchTheNextBuffer: 

MOV 

MOV 

CMP 

JE 

RET 

BX, currentBootBuffer 

SI, ES: [BX].bootDataStart 

SI, ES: [BX].bootDataEnd 
WaitForFulIBuffer 

;Every time we get a new buffer 
;we have to first check that it 
: is really full before we start 
iprocessing it. 

PrepareToFetchBuffer: 

MOV 

MOV 

PUSH 

BX, ES: [BX].nextBoot8uffer 
currentBootBuffer, BX 

BX 

:Update the pointer to the 
;next buffer to process, then do 
:the obligatory rest. 


%NotifyCond1tion (OFFSET bootBufferEmpty) 
POP BX 

JMP FetchTheNextBuffer 


ReloadBuffer 


-- IOP Boot block early interpretation: 

- Assume parameter locations upon entry into this procedure 

- are as follows: 


AH = zzxO - remaining bits to be tested. 
BX = pointer to the buffer to process. 
Sit = BootBlock.Type 


BX = pointer to the buffer to process. 
Sit = BootBlock.Type 


ProcessIOPBlock 

PROC 

NEAR 


OoIOPBlock: 

SHL 

AH, oneBit 

;This could be a Start. Initialize 


JC 

IOPWriteORUnknown 

;Checksum or Write block for IOP. 

ItsStartORInitial ize: 

SHL 

AH, oneBit 

;Sure. but which one is it? 


JC 

ItsStart 

;Go process an IOP Start block! 


JMP 

InitialIzelOP 

;Go process an IOP Initialize block! 

ItsStart: 

JMP 

StartlOP 


IOPWriteORUnknown: 

SHL 

AH, oneBit 

;If it is a checksum block go to 


JC 

ItsUnknown 

;the checksum routine otherwise 


JMP 

SHORT WritelOPMemory 

;go write IOP memory. 

Itsllnknown: 

JMP 

UnknownBlock 



;Notice that we never bothered checking BootBlock.Type(Dalsy(Daybreak) because for the 
;IOP, the two worlds are identical! 


ProcessIOPBlock ENDP 


-- CP Boot block early interpretation: 

- Assume parameter locations upon entry into this procedure 

- are as follows: 
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AH = zzxO - remaining bits to be tested. 
BX = pointer to the buffer to process. 
Sit = BootBlock.Type 


AH = xOOO - remaining bit to be tested. 
BX = pointer to the buffer to process. 
Sit = BootBlock.Type 


ProcessCPBlock 

PROC 

NEAR 


OoCFBlOck: 

ROL 

AH, oneBit 

;Save this bit for use 
later In CheckBankConfig. 

;This could be a Start, Initialize 


JC 

CPWriteORChecksum 

;or Write block for CP. 

StartORInitialize: 

CALL 

DWORD PTR CPStartOrlnitProc 



RET 

•.Return into ProcessEmulatorFi le 


Code for starting the CP should have been loaded and 
started from the last IOP init block which will have 
initialized CPStartORInitialize. 



: SHL 

AH, oneBit 

;Sure, but which one is it? 


; JC 

ItsStartCP 

;Go process a CP Start block! 


; JMP 

InitializeCP 

;Go process a CP Initialize block! 

: ItsStartCP: 

JMP 

StartCP 


CPWriteORChecksum: 

SHL 

AH, oneBit 

;If it is an unknown block go to 


JC 

ItsChecksum 

;the unknown block routine otherwise 


CALL 

DWORD PTR WriteCSProc 



RET 

;Return into ProcessEmulatorFile 


;Code 

for loading the CP should 

have been loaded and 


; started from the last IOP init 

block which will have 


; initialized CPStartORInitialize. 


; JMP 

WriteControlStore 

:go write CP control store. 

ItsChecksum: 

JMP 

Checksum 


ProcessCPBlock 

ENDP 




-- Boot section # 

- Assume parameter locations upon entry into this procedure 

- are as follows: 


BX = pointer to the buffer to process. 
Sit = BootBlock.Type 


BX = pointer to the buffer to process 
Sit = BootBlock.Type. 


WritelOPMemory 

PROC 

NEAR 



WritelOPMem: 

SHL 

AX, oneBit 


;Ignore Daisy or Daybreak bit 


SHL 

AX, oneBit 


-.Should this be stored in main memory? 


JNC 

WritelnLRAM 



WrltelnMemory: 

MOV 

DI, bootMemoryPtr 




SHL 

DI, Nibble 




JMP 

ReadOffset 



WritelnLRAM: 

MOV 

DI, bootBufferPtr 



ReadOff set: 

CALL 

LoadAXFromBootBuf 


;The next word in the 


ADD 

DI, AX 


: boot block is the 
: address to be written to. 





-.Boot clients should offset their 
;code from zero! jmm:84-12-ll:later 


CALL 

LoadAXFromBootBuf 




MOV 

CX, AX 




;And now we want to get the 

data 



: count 

to use in emptying this 



; boot 

block, then point to 

the data itself. 


CALL 

IncrementSI 



Uni oadBootBI ock: 

MOV 

AL, ES: [BX][SI] 


:As we empty the block. 


MOV 

BYTE PTR ES: [DI], 

AL 

;we have to keep testing to make sure 
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;that we have not reached the end of the 
[boot buffer. 



CALL 

IncrementSI 


INC 

DI 


LOOP 

UnioadBootBlock 


RET 


WritelOPMemory 

ENDP 



-- Boot section ft 

- Assume parameter locations upon entry into this procedure 

- are as follows: 


BX = pointer to the buffer to process. 
Sit = BootBlock.Type 


BX = pointer to the buffer to process. 
Sit = BootBlock.Type 


InitializelOP 
InitlOP: 


Memorylnit: 


LRAMInit: 

JumpTablelnit: 


EnterlnitlOP: 


InitializelOP 


PROC NEAR 


SHL 

SHL 

JNC 

MOV 


JMP 

MOV 

SHR 

MOV 


AX, oneBit 
AX. oneBit 
LRAMInit 

AX, bootMemoryPtr 


JumpTablelnit 
AX, bootBufferPtr 
AX, Nibble 

jumpTable.iopEntryCS, AX 


[Ignore Daisy or Daybreak bit 
;should this be started in main memory? 

;Set up CS for main memory 
;This had better not happen until 
;AllocSgs has run since it is responsible 
;for setting up bootMemoryPtr 

;Set up CS for boot code in local RAM 
;to point to start of boot buffer 
-.and store into jump table. 


CALL LoadAXFromBootBuf 

;The next word in the Boot 
;block is the address to go to 
;and which should return to us 
;upon completion. 

MOV jumpTable.iopEntry, AX [Notice that we are giving 

PUSHA [boot clients the ability 

PUSH ES [to specify only the offset 

CALL DWORD PTR jumpTable.IopEntry ;to their entry point. 
POP ES 

POPA 

CALL IncrementSI 

RET 


ENDP 


Boot section # 

--- Assume parameter locations upon entry into this procedure 

- are as follows: 


BX = pointer to the buffer to process. 
Sit = BootBlock.Type 


BX = pointer to the buffer to process. 
Sit = BootBlock.Type 


StartlOP 

PROC 

NEAR 



StartThelOP: 

SHL 

AX, oneBit 

;Ignore 

Daisy or Daybreak bit 


SHL 

AX, oneBit 

; should 

this be started in main memory? 


JNC 

LRAMStart 



MemoryStart: 

MOV 

AX, bootMemoryPtr 

[Set up 

CS for main memory 


JMP 

JumpTableStore 



LRAMStart: 

MOV 

AX, bootBufferPtr 

[Set up 

CS for boot code in local RAM 


SHR 

AX, Nibble 

;to point to start of boot buffer 

JumpTableStore: 

MOV 

jumpTable.startRAMOpieCS 

. AX ;and store into jump table. 


CALL 

LoadAXFromBootBuf 




; The address we get here and save 
;is the entry point of RAMOpie. 
[Prior to this we had saved the 
[address of a "No Opie entry point" 
MOV jumpTable.startRAMOpie, AX 
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;that we are giving boot clients 

•v ; the ability to specify only 

CALL IncrementSI ;the offset to their entry point. 

RET 

StartlOP ENDP 


-- Boot section ff 

- Assume parameter locations upon entry into this procedure 

- are as follows: 


AH = 2000 - remaining bit to be tested. 
BX = pointer to the buffer to process. 
Sit = BootBlock.Type 


BX = pointer to the buffer to process. 
Sit = BootBlock.Type. 


;ALL OF WriteControlStore IS COMMENTED OUT. 


:WrlteControlStore 
;WriteCntlStore: 


;WriteDaisyControlStore: 


;WriteDaisysCS: 


: LetsGetACSWord: 
; LoopForCSWord: 


; WriteDaisyCSWord: 



CALL CheckBankConfig 

;Make sure its the right fb 

; CALL 

IncrementSI 

;We want to point to the 

; SHL 

AX, oneBit 

;address part of the buffer. 

: JC 

WriteDaybreakControl Store ;But first see if the block 
;is for Daisy or Daybreak. 

: IN 

AX, machinelDPort 

;Find out if this is a Daisy 

: AND 

AX, maehinelDMask 

;or a Daybreak and act accordingly. 

: CMP 

AX, Daisy 

:or a Oaybreak and act accordingly. 

; JE 

WriteDaisysCS 


: JMP 

DumpCSBlock 


; MOV 

AH, ES: [BX][SI] 

;Get the low byte of the 

; CALL 

IncrementSI 

;address, fetch the high byte, 

; MOV 

AL, ES: [BX][SI] 

;then save in BP. Recall shift 

; MOV 

BP, AX 

;order for the Sirius chip access. 

: CALL 

IncrementSI 

;After which, we want to fetch 

;MOV 

CH, ES: [BX][SI] 

:the CS block length and we will 

; CALL 

IncrementSI 

;u$e the BP register as a counter 

; MOV 

CL, ES: [BX][SI] 

;since we are out of registers. 


; PUSH CX ;jmm-84- 

10-24!!!!!!!stack trouble! ! ! ! ! ! 

: MOV 

CX, CSsizeWordCount 


;CALL 

IncrementSI 

;Get the control store word to 

;M0V 

AH, ES: [BX][SI] 

;be written and pop it onto stack 

;CALL 

IncrementSI 

;so as to restore it to its correct 

; MOV 

AL, ES: [BX][SI] 

;order when writing it later. 

: PUSH 

AX 


; LOOP 

LoopForCSWord 


MOV 

CX, CSsizeWordCount 


MOV 

AL, loadShiftRegister 

;Get CS ready to write a word! 

OUT 

CPoutputPort, AL 


POP 

AX 

;Send the 48-bit control store 

PUSH 

CX 

;word to the shift register of 

MOV 

CX, dataWordBitCount 

:Sirius chip. 

CALL 

ShiftDataToCS 


POP 

CX 


LOOP 

WriteDaisyCSWord 


MOV 

AX, BP 

;Finally get the saved address 

CALL 

ShiftDataToCS 

;of the word to write. 

MOV 

AL, (notLoadShiftRegister OR writeCS OR interruptCP) 

OUT 

CPoutputPort, AL 


MOV 

AL, grabData 


OUT 

CPoutputPort, AL 


MOV 

AL, (loadShiftRegister OR notWriteCS) 

OUT 

CPoutputPort, AL 


MOV 

AL. notGrabData 


OUT 

CPoutputPort, AL 


INC 

BP 

;Update to next address 

POP 

CX 


LOOP 

LetsGetACSWord 


CALL 

IncrementSI 


RET 

e: 

IN 

AX, machinelDPort 

;Find out if this is a Daisy 

AND 

AX, maehinelDMask 

;or a Oaybreak machine and 

CMP 

AX, Daybreak 

:dump block if it is for 

JE 

WriteDaybreakCS 


JMP 

DumpCSBlock 

;Daisy. 
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;WriteDaybreakCS: CALL LoadAXFromBootBuflateEntry 

;We first want to set the CS 
;bank register then get the CS 
;address that this block is to 
;be written to. 


DayBreak’s control store is an I/O port. 

Put the cs address into DX. 

CALL LoadCXF romSootBuf 

MOV OX, CX 

We want to point to the count 

of CS words in this block, 
from which we will fetch the 
CS block size counter and 

save it in DI - we are again out of registers! 

CALL LoadCXFromBootBuf 

MOV DI, CX ; 

MOV BP, DX 


;MOV DX, daybreakBankRegister ;First let us set up the CS bank 
;OUT DX, AL ;register. 


;Writel)aybreakCSBlock: 

MOV 

DX, BP 

: OR 

DX, daybreakCSPortMask 


;MOV 

CX, CSWordByteSize 

;WriteDaybreakCSWord; 

CALL 

IncrementSI 


MOV 

AL, ES: [BX][SI] 



OUT 

DX, AL 



ADD 

DX, nextCSByte 



LOOP 

WriteDaybreakCSWord 



INC 

BP 



DEC 

DI 



JNZ 

WriteDaybreakCSBIock 



CALL 

IncrementSI 


;Also need to save initial CS adrs. 

;A single control store word 
;is made up of six bytes. The 
;layout of the control store with 
irespect to the 4K ports is as 
; follows: 8MH - D«H where 

has the MSB and DiWH has 
;the LSB. The CS is loaded in six 
:byte data streams. Update CS word count. 
;Loop while not done with CS block. 


;RET 


;WriteControlStore ENDP 


-- Boot section # 

- Assume parameter locations upon entry into this procedure 

- are as follows: 


AH = zOOO - remaining bits to 
AL * xxxx - remaining bits to 
BX - pointer to the buffer to 
Sit = BootBlock.Type 


be tested. 

be dumped in this case, 
process. 


BX = pointer to the buffer to process. 
Sit = BootBlock.Type. 


;ALL OF InitializeCP IS COMMENTED OUT. 


;InitializeCP 
;InitCP: 


; InitializeDaisyCP: 


;WMteDaisyCPAddress: 


:InitializeDaybreakCP: 


PROC NEAR 

CALL CheckBankConfig 

;CALL IncrementSI 

:SHL AX, oneBit 

;JC InitializeDaybreakCP 


IN AX, machinelDPort 

AND AX, machinelDMask 

CMP AX, Daisy 

JE WriteDaisyCPAddress 

JMP DumpCSBlock 


;JMP SHORT StartDaisyCPANDWait 


MOV CX, 5 

CALL DumpCSBlock 

IN AX, machinelDPort 

AND AX, machinelDMask 

CMP AX, Daybreak 

; JNE InitializeDaybreakCPRet 


;Make sure its the right fb. 
We want to point to the 
address part of the buffer. 

But first see if the block 
is Daisy or Daybreak. 


Find out if this is a Daisy 

or a Daybreak and act accordingly. 


Load CP address for Daisy before 
starting the CP. 


5 bytes to end of boot block, 
skip over address (not used) 

Find out if this is a Daisy 

or a Daybreak and act accordingly. 


;StartDaybreakCPANDWait: 
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;InitializeDaybreakCPRet: 


PUSHA 

% 'Enable(mesaProce$$orInterrupt) ;turn on the interrupt, but 

%'DisableInterruptsTilINextWait ; don’t allow it till we’re ready 

CALL DaybreakCPStart ;let CP run 

%'WaitForlnterrupt (1) ;init routines should take < 1 sec 
IN AX, ClrMesalntr ;clear Mesa interrupt 

%’01sable(mesaProcessorInterrupt); and turn it off 
%'WaltForSystem ;drop to system level 

POPA 

CALL DaybreakCPHal t ;stop the CP (so can load more code) 

RET 


;InitializeCP ENDP 


-- Boot section # 

- Assume parameter locations upon entry into this procedure 

- are as follows: 


AH = zOOO - remaining bits 
AL 3 xxxx - remaining bits 
BX = pointer to the buffer 
Sit = BootBlock.Type 


to be tested. 

to be dumped in this case 

to process. 


BX = pointer to the buffer to process. 
Sit = BootBlock.Type. 


;ALL OF StartCP IS COMMENTED OUT. 


;StartCP 



PROC NEAR 


:StartTheCP: 

CALL 

CheckBankConfig 

;Make sure its the right fb. 




;We want to point to the 



CALL 

IncrementSI 

:address part of the buffer. 



SHL 

AX, oneBit 

:But first see if the block 

;StartDa1syCP: 


JC 

StartDaybreakCP : 

Is Daisy or Daybreak. 


IN 

AX, machinelDPort 

;Find out if this is a Daisy 



AND 

AX, machinelDMask 

;or a Daybreak and act accordingly 



CMP 

AX, Daisy 




JE 

DoDaisyStart 


;DoDaisyStart: 


BMP 

DumpCSBl ock 

;Load CP address for Daisy before 
ileaving this procedure. 


;CALL 

IncrementSI 



;RET 



:StartDaybreakCP: 


Daybreak cannot currently use a start address, so dump its 



Start 

Block right here! 




MOV 

CX, 5 

5 bytes to end of boot block 



JMP SHORT OumpCSBlock 

Note that a call to IncrementSI 





was commented out above giving us 

5 instead of the 4 below. 



IN 

AX, machinelDPort 

;Find out if this is a Daisy 



AND 

AX, machinelDMask 

;or a Daybreak and act accordingly 



CMP 

AX, Daybreak 



; JNE 

DumpCSBlock 



;CALL 

IncrementSI 

;jmm;1984-11-08:For now dump adrs. 



CALL 

IncrementSI 

;jmm:1984 -11-08:For now dump adrs. 


;CALL 

IncrementSI 

;jmm:1984-11-08:For now dump adrs. 


;CALL IncrementSI 
;RET 


ENDP 


-- Boot section tt 

- Assume parameter locations upon entry into this procedure 

- are as follows: 
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;waitForMesainterrupt 


PROC 


NEAR 


:WaitForMesaInt: 


;CALL DaisyCPHal t 

RET 


;Restore registers, then 

;halt the CP and keep 
;processing the boot file. 


;waitForMesalnterrupt ENDP 


-- Boot section # 

- Assume parameter locations upon entry into this procedure 

- are as follows: 


;BadMesainterrupt 

PROC 

; BadMesalnt: 

RET 

;BadMe$aInterrupt 

ENDP 


-- Boot section ft 

- Assume parameter locations upon entry into this procedure 

- are as follows: 


AH = xOOO - remaining bit to be tested 
BX = pointer to the buffer to process. 
Sit = BootBlock.Type 


Checksum 

PROC 

NEAR 

ChecksumBegin: 

SHL 

AH, oneBit 

JNC 

DoChecksum 


JMP 

EOForMultipleDBs 

DoChecksuin: 

; MOV 

CX. 2 


; JMP 

SHORT DumpCSBlock 


CALL 

IncrementSI 


CALL 

IncrementSI 


RET 


Checksum 

ENDP 



This could be a Start, Initialize 
or Write block for CP. 

We might be done with this file. 


;jmm:1984-11-06 :For now we will 
;jmm:1984-11-06 :just dump the 
;jmm:1984-11-06 :checksum type and 
;jmm:1984-11-06 :the checksum. 


-- Boot section ft 

- Assume parameter locations upon entry into this procedure 
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are as follows: 





iDaisyCPHalt 

PROC 

;DsyCPHalt: 

RET 

;DaisyCPHalt 

ENDP 

;DaybreakCPHalt 

PROC 

jDybrkCPMalt: 

MOV 

;OUT 


: SHL 


; SHL 


; RET 

; DaybreakCPHal t 

ENDP 

-.DaybreakCPStart 


;DybrkCPStart: 

MOV 

;OUT 


; RET 


:DaybreakCPStart 


NEAR 


NEAR 
AX. 0 

WriteCSReg, AX 

AX, 15 : delay 

AX, 13 : at least 38 cycles 


PROC NEAR 

AX, 0200H 
WriteCSReg, AX 


ENDP 


-- Boot section # 

- Assume parameter locations upon entry into this procedure 

- are as follows: 


AL = BootBlock.Type.lowByte. 

BX = pointer to the buffer to process, 
SI = BootBlock.Type 


EOForMul't ipleDBs 

PROC 

NEAR 

EOForMultDBs: 

CMP 

AH, ((EOF AND highNibbleMask) OR 4) 

;The 4 is there because 

back at 

DoCPBlock we Rotated AH instead of shifting It. 


JNE 

UnknownBlock 


CMP 

AL, EOF 


JNE 

MultipieDBs 


;If this is diagnostics and ether booting 


: send 

a shut up message to boot server. 


MOV 

AL, ES:bootType 


CMP 

AL, diagnostic 


JNE 

GoToLoader 


MOV 

AX, device 


CMP 

AX, ethernet 


JNE 

GoToLoader 


MOV 

8ootDeviceIORSpace.useStreamProtocol, shutUp 


;TransmitFrame will send error packet. 


CALL 

TransmitFrame ;in RAMEthBt. TransmitFrame will 



; cause an unresoved 



: external warning when 



; building Disk and Floppy 



; initials. 

GoToLoader: 

JMP 

ProcessLoaderFile 

MultipleDBs: 

JMP 

ProcessMultipleDBsFile 


RET 


EOForMultip 1eDBs 

ENDP 
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-- Boot section ft 

- Assume parameter locations upon entry into this procedure 

- are as follows: 


IncrementSI 

PROC 

NEAR 

IncSI: 

INC 

SI 


CMP 

SI. ES: [BX].bootDataEnd 


JLE 

BufferNotYetEmpty 


MOV 

ES: [BX].bootDataStart, Null 


MOV 

ES: [BX].bootDataEnd , Null 


CALL 

PrepareToFetchBuffer 


; POP 

jumpTable,processBootBlock 


; MOV 

currentBlockSequence. OFFSET BootBlockldentified 

BufferNotVetEmpty: 

RET 


IncrementSI 

ENDP 



IncSIFar is what CP specific code will use to call IncrementSI. The address 
will be loaded into the 10 Region prior to beginning to interpret blocks. 


IncSIFar 


PROC FAR 

CallLocal: 

CALL 

IncrementSI 


RET 


IncSIFar 

ENDP 



-- OumpCSBlock: Call IncrementSI CX times and return. Some procedures Jmp 
here and use this return as their own in order to dump the rest of the 
-- block. Others Call it to move past uninteresting data in the boot block. 

- Assume parameter locations upon entry into this procedure 

- are as follows: 


CX = Count of bytes to dump. 

BX = pointer to the buffer to process. 
SI = Offset within buffer 


BX = pointer to the buffer to process. 
SI = CX bytes further through stream. 


;DumpCSBlock 

PROC 

NEAR 

; DumpBlock: 

CALL 

IncrementSI 


; LOOP 
: RET 

DumpBlock 

;DumpCSBlock 

ENDP 



;8ump SI with checking for end of 
;boot buffer until CX runs down. 


Boot section # 

- Assume parameter locations upon entry into this procedure 

- are as follows: 
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* 



UnknownBIock 
UnkBlock: 


UnknownBIock 


PROC NEAR 

PUSH bootingError 

PUSH unKnownBootBlock 

%Jam (BootStrapHandlerlD,OFFSET bootTask) 

%WaitForSystem ;never returns! 

ENDP 


-- Boot section # 

- Assume parameter locations upon entry into this procedure 

- are as follows: 


NoRAMOpieEntryPoint 
NoStart: 


NoRAMOpieEntryPoint 


PROC NEAR 

PUSH bootingError 

PUSH noRAMStartAddress 

%Jam (BootStrapHandlerlD.OFFSET bootTask) 

“/.WaitFor System : never returns! 

ENDP 


-- Boot section # 

- Assume parameter locations upon entry into this procedure 

- are as follows: 


AX = input data left justified. 
CX = count of data to shift. 


DX was trashed here. 


;ShiftOataToCS 

PROC 

NEAR 


;ShiftOataToCS: 

MOV 

OX, AX 

;We want to rotate the data so that 


; ROL 

DX, Nibble 

;we can shift it out a bit at time 





;from the 5-th bit which is the LSB. 

;DataShiftLoop: 

MOV 

AX, ((CSInputBitMask SHL 8) OR CSToggleBit) :We have 



AND 

AH, DL 

;the data into control store one bit 



OR 

AL. AH 

;at a time. So we shift the appropriate 



OUT 

CPoutputPort. 

AL ;bit to bit five in OX which corresponds 



MOV 

AL, notCSToggleBIt ;to the correct bit for the output 



OR 

AL, AH 

;port and then do the appropriate 



OUT 

CPoutputPort, 

AL ;toggling to get the bit accepted. 



ROR 

DX, oneBit 

;Get the next bit ready. 



LOOP 

DataShiftLoop 

;We will loop until all the bits 





;are sent! 


RET 



-.ShiftDataToCS 

ENDP 
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-- Boot section ft 

- Assume parameter locations upon entry into this procedure 

- are as follows; 


BX = pointer to the buffer to process. 
Sit = BootBlock.Address 


;WriteSiriusStartAddress 


PROC NEAR 


;GetCPStartAddress: 


;MOV CX, CSaddressLoopCount 

CALL IncrementSI 

;MOV AH, ES: [BX][SI] 

;CALL IncrementSI 

;MOV AL, ES: [BX][SI] 

;PUSH AX 

;LOOP GetCPStartAddress 


MOV AL, loadShiftRegister 

OUT CPoutputPort. AL 

MOV AX, paritylnterruptTrapFlags 

MOV CX, CPf1agsBitCount 

CALL ShiftDataloCS 

MOV CX, dataWordBitCount 

POP AX 

CALL ShiftDataToCS 

MOV CX, dataWordBitCount*CSsizeWordCount 

CALL ShiftDataToCS ;Data here is garbage. 

POP AX 

CALL ShiftDataToCS 

MOV AL, notLoadShiftRegister 

OUT CPoutputPort, AL 


: RET 

;WriteSIriusStartAddress ENDP 


-- Boot section ft 

- This procedure gets called after the virtual memory map has 

- p een initialized, map registers set. Its task is to load the 

--- Loader in the specified virtual memory location then we are 

- ready to give up booting ghost! 


loaderVMLocBase = loaders base location in virtual 

memory a 32-bit word containing virtual memory jmm????| 
address should have been set up at VMM initialization.! 


ProcessLoaderFi1e PROC NEAR 


DoLoaderFile: POP 

MOV 
MOV 
MOV 
MOV 
CMP 
JE 
JMP 


AX 

ES: [BX].bootDataStart, Null 
ES: [BX].bootDataEnd , Null 
BX, startOfBootBufferPool 
currentBootBuffer, BX 
bootType, normal 
GoGetTheLoaderFile 
BootFadeOut 


Clean the stack. 

We are done loading the 
emulator so release buffer. 
This is a new file so start 
processing buffers anew. 

If it is a diagnostics boot 
we are done, otherwise we 
;should go get the loader file 

here when doing 


;Outstanding issue - termination of communcation 
;ethernet diagnostics booting. 

GoGetTheLoaderFile: %NotifyCond1tion (OFFSET getBootFile) 

%Not1fyCondition (OFFSET bootBufferEmpty) 

;disp1 ay mp code for fetching MesaDove 

MOV AX, mpFetchMesaDove 

CALL D1sp1ayMPCode 

ThereMightBeSomeMore: %WaitForCondition (OFFSET bootBufferFul1,loaderTimeout) 

JNC MoreLoader :1f not timed out 

ZoWai tFo rCond it ion (OFFSET fin i shedLoaderF i 1 e Fetch , 1 oaderT i me out 
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JC 

ThereMightBeSomeMore 

;if timed out 


JMP 

BootFadeOut 


MoreLoader: 

MOV 

BX, currentBootBuffer 

;Every time we get a new buffer 


MOV 

SI, ES: [BX].bootDataStart 

;we have to first check that it 


CMP 

SI, ES: [BX].bootDataEnd 

;is really empty before we start 


JE 

ThereMightBeSomeMore 

,'processing it. 


PUSH 

ES 




%E$tablIshlOPAccess (generalMapRegister,loaderVirtualMemoryLocation) 


INC 

WORD PTR loaderVirtualMemoryLocation 


MOV 

DX, ES 


POP 

ES 


PUSH 

DS 


MOV 

DS, DX 


ASSUME 

OS:NOTHING 


MOV 

CX, ES: [BX].bootDataEnd ;We will load a page of the germ 


SUB 

CX, ES: [BX].bootDataStart ;a time. 


INC 

CX 


ADD 

SI, BX 

WriteAPageOfLoader: 

MOV 

AL, ES: [SI] 


MOV 

DS: [DI], AL 


INC 

DI 


INC 

SI 


LOOP 

WriteAPageOfLoader 


POP 

DS 


ASSUME 

DS:BootStrapIOR 


MOV 

BX, currentBootBuffer 


MOV 

ES: [BX].bootOataStart, Null 


MOV 

ES: [BX].bootDataEnd , Null 


MOV 

BX, ES: [BX].nextBootBuffer 


MOV 

currentBootBuffer, BX 


%NotifyCondition (OFFSET bootBufferEmpty) 


JMP 

MoreLoader 

ProcessLoaderFile 

ENDP 



-- Boot section ff 

- Assume parameter locations upon entry into this procedure 

- are as follows: 


BootFadeOut 

PROC 

NEAR 

BootDone: 

MOV 

AX, mpRunMesaDove 


CALL 

DisplayMPCode 

StartRam: 

JMP 

DWORD PTR jumpTable.startRAMOpie ;Boot task should be jammed by 
;the RAMOpie task that is being loaded. 

BootFadeOut 

ENDP 



-- Boot section ft 

- Assume parameter locations upon entry into this procedure 

- are as follows: 


AL = BootBlock.Type.1owByte. 

BX = pointer to the buffer to process. 
SI = BootBlock.Type 
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ProcessMultipleDBsFIle 

PROC 

NEAR 


DoMultipleDBsFile: 

POP 

AX 

;Clean the stack. 


CMP 

skipUserlnterface, normal ;Is 

this first time? 


JNE 

MoveReentryPointToJumpTable ;If not, parms are set 


MOV 

bootOverlayRequest, 1 ;else 

default to 1 


JMP 

SHORT LoadOverlayNumber 



MoveReentryPointToJumpTable; 


LoadOverlayNumber: 


IsOurOBInThisBuffer: 


MOV DI, bootOverlayReentry ;Monitor has set up a 
MOV jumpTable.startRAMOpie, 01 ;reentry point for 
MOV DI, bootOverlayReentry+2 -.overlay booting to use, 

MOV jumpTable.startRAMOpleCS, 01 ;$o move it to jump table 
MOV DI, bootOverlayRequest 

%MultiplyByTwo (DI) 

[BX].bootDataStart ;We may now fetch the offset of 
;the diagnostics boot file desired. 
[8X][DI] ;We want the n-th *.db file in this boot 

[BX][DI]+1 ;fi1e so let's get its offset. 

stable has word offset -- 
jchange to byte offset 
;with overflow in DL. 


;Get the size of the buffer and check 
;to see if this is the buffer that the 


MOV 

SI, 

ES: 

ADD 

DI, 

SI 

MOV 

AH, 

ES: 

MOV 

AL, 

ES: 

MOV 

DI, 

AX 

XOR 

DL, 

DL 

SHL 

DI, 

1 

RCL 

DL, 

1 

MOV 

AX, 

ES: 

SUB 

AX, 

SI 

INC 

AX 


MOV 

CX, 

AX 

CMP 

OL, 

0 


JNE 

SUB 

JNC 


TryNextBuffer 
AX, DI 

TheWantedDBIsHere 


;desired db file Is in. If it is we want 
;to go keep processing it as normal. 


T ryNextBuffer: 


TheWantedDBIsHere: 


SUB DI, CX 

SBB DL, 0 

MOV ES: [BX],bootDataStart, Null 

MOV ES: [BX].bootDataEnd, Null 

CALL PrepareToFetchBuffer 

JMP IsOurOBInThisBuffer 

ADD SI, DI ;We now have the offset of the file we 

JMP StartSequence ;have been looking for. 


ProcessMultipleDBsFile ENDP 


Space could be saved by using the version of this proc that lives in ROM. 

DisplayMPCode -- Call this to put a number into the curser as an MP code. 

- Assume parameter locations upon entry into this procedure 

- are as follows: 


AX = mp code to be displayed 


DisplayMPCode 
RamDispMPCode: 


DisplayMPCode 


PROC 

PUSH ES 
PUSHA 

PUSH AX 

%EstablishHandlerAccess (MaintPanelHandlerlD) 

POP AX 

ASSUME ES:MaintPanelIOR 
MOV maintPanelCode, AX 

7aNotifyHandlerCondition (MaintPanelHandlerlD.OFFSET maintPanelChanged) 

%WaitForSy$tem 

POPA 

POP ES 

ASSUME ES:IOPELocalRAM 

RET 

ENDP 


-- Determination of control store configuration: 

- Assume parameter locations upon entry into this procedure 

- ar * e as follows: 


No assumptions 
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Upon return: 

csBankConfIguration Is set as 
four K control store 
eight K control store 
AX smashed 
BX smashed 


follows: 
= > 1 
= > 2 


;csBankConfiguration DB 0 


;This will go into IORegion. 


;GetCSBankConfig 


;GetCSBankCfg: 

;fourKEEPromFormat 
;GoodEEProm: 


PROC NEAR 

:F1aure out how much control store we have. 


;Th1s code could be moved into 
; Local ram space. 
%'ReadEEProm(eePromMemSize. 1) 


; JNC 

GoodEEProm 

EQU 

10H 


;MOV 

AX, 

fourKEEPromFormat 

AND 

AL, 

OFOH 

; MOV 
;RET 

CS: 

csBankConfiguration 


i IOP initial to save 

;AX <- virt mem,,eeprom. 
;Check eeprom validity. 

:0efault is 1 bank. 

;Get rid of VM size. 

AL :Save it for later. 


;GetCS8ankConfig 


ENOP 


-- LoadAXFromBootBuf 

This procedure just loads AX from the boot buffer byte at a time calling the 
procedure IncrementSI to move the pointer along. This assures that the end 
of the boot buffer will be detected and handled correctly. 

- Assume parameter locations upon entry into this procedure 

- are as follows: 


ES:[BX][SI] byte before the first we want 


Upon return: 

ES:[BX][SI] 2 bytes further in the stream. 
AX loaded from ES:[8X][SI] 


LoadAXF romBootBuf 


PROC NEAR 


CALL IncrementSI 

LoadAXFromBootBufLateEntry: 

MOV AH. ES: [BX][SI] 

CALL IncrementSI 

MOV AL. ES: [BX][$I] 

RET 


LoadAXFromBootBuf 


ENDP 


-- LoadCXFromBootBuf 

This procedure just loads CX from the boot buffer byte at a time calling the 
procedure IncrementSI to move the pointer along. This assures that the end 
of the boot buffer will be detected and handled correctly. 

- Assume parameter locations upon entry into this procedure 

- are as follows: 


£S:[BX][$I] byte before the first we want 


Upon return: 

ES:[BX][SI] 2 bytes further in the stream. 
CX loaded from ES:[BX][SI] 


: LoadCXF romBootBuf 


PROC NEAR 


:CALL IncrementSI 
: LoadCXF romBootBufLateEntry: 

;MOV CH. ES: [BX][SI] 
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;LoadCXFromBootBuf 


CALL IncrementSI 

MOV CL. ES: [BX][SI] 

RET 

ENDP 


EVEN 

EndOflnitial EQU $ 


IOPEInRAM ENOS 


**************4 


END 
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-- File: ShowCharsImpl .mesa - last edit: 

-- Mader.ES 7-Aug-85 9:26:25 

-- Copyright (C) 1985 by Xerox Corporation. All rights reserved. 


DIRECTORY 

Attention USING [AddMenuItem, Post], 

Heap USING [Create], 

MenuData USING [Createltem, MenuProc], 

Selection USING [Free, CanYouConvert, Convert, Enumerate, EnumeratlonProc, Value], 

XChar USING [Code, Set], 

XFormat USING [Object, Octal, WrlterObject], 

XStrlng USING [AppendReader, Character, Empty, FreeWrlterBytes, FromSTRING, Map, MapCharProc, NewWrlterBody, Reader, ReaderBody, 
ReaderFromWrlter, Writer, WrlterBody]; 

ShowCharsImpl: PROGRAM 

IMPORTS Attention, Heap, MenuData, Selection, XChar, XFormat, XString = 

BEGIN 


zone: UNCOUNTED ZONE - Heap.Create [Initial: 1]; 
first: BOOLEAN <- TRUE; 

AppendOctal: PROCEDURE [to: XString.Writer, n: CARDINAL] = 

BEGIN 

xfo: XFormat.Object «■ XFormat .WrlterObject [to]; 

XFormat.Octal [Gxfo, n] ; 

END; 

ShowStrlng: Selection.EnumeratlonProc = 

BEGIN 

r: XStrlng.Reader = element.value; 

Attention.Post [s: r, clear: first]; 
first *• FALSE; 

END" 

ShowCodes: Selection.EnumeratlonProc * 

BEGIN 

r: XString.Reader = element.value; 

w: XString .WrlterBody <- XString .NewWriterBody [100, zone]: 
open; XString.ReaderBody <> XString .FromSTRING ["["L]; 
close: XString.ReaderBody «• XStrlng.FromSTRING ["]"Lj; 
comma: XString.ReaderBody 4- XStrlng.FromSTRING [", "L]; 

MapChars: XString.MapCharProc = 

BEGIN 

IF -XString.Empty [XString.ReaderFromWrlter [Gw]] OR -first 
THEN XString.AppendReader [to: Gw, from: Gcomma]; 

XString.AppendReader [to: Gw, from: Gopen]; 

AppendOctal [to: Gw, n: XChar.Set [c]]; 

XString.AppendReader [to: Gw, from: Gcomma]; 

AppendOctal [to: Gw, n: XChar.Code [c]]; 

XString.AppendReader [to: Gw, from: Gclose]; 

RETURN [stop: FALSE]; 

END; 

[] +- XString.Map [r, MapChars]; 

Attention.Post [s: XString.ReaderFromWriter [Gw], clear: first]; 
first <- FALSE; 

XString.FreeWrlterBytes [Gw]; 

END; 

ShowChars: MenuData.MenuProc = 

BEGIN 

dlsplayProc: Selection.EnumeratlonProc = LOOPHOLE [itemData]; 

first <- TRUE; 

SELECT TRUE FROM 

Salection.CanYouConvert [target: string, enumeration: FALSE] -> 

BEGIN 

v: Selection .Value *• Selection .Convert [string]; 

[] <- dlsplayProc [v, NIL]; 

Selection.Free [@v]; 

END; 

Selection.CanYouConvert [target: string, enumeration: TRUE] => 

[] <■ Selection.Enumerate [target: string, proc: dlsplayProc]; 

ENOCASE => 

BEGIN 

needStrlng: XString.ReaderBody *■ XString .FromSTRING ["Please select some characters and try again. "L]; 

Attention.Post [GneedStrlng]; 

END; 

END; 

Inlt: PROCEDURE * 

BEGIN 

ShowChars: XString. ReaderBody «■ XStrlng.FromSTRING ["Show Characters"L]; 
showCodes: XString .ReaderBody <- XStrlng.FromSTRING ["Show Character Codes"L]: 

Attention.AddMenuItem [ 

MenuData.Createltem [ 

zone: zone, name: GshowChars, proc: ShowChars, ItemData: LOOPHOLE [ShowStrlng]]]; 
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Attention.AddMenuItem [ 

MenuData.Createltem [ 

zone: zone, name: OshowCodes, proc: ShowChars, ItemData: LOOPHOLE [ShowCodes]]]; 

END; 

I n 11 [ ] : 

END. 
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<<File K4.mesa 


deLaBeaujardiere:GSBU North:Xerox27-Apr-87 12:57:34 


>> 

DIRECTORY Ascii, Containee, FormWindow. 

NSFile, NSFi1eStream, NSString, 

PropertySheet, Prototype. StarWindowShel1. Stream, 
Window, XString; 


K4: DEFINITIONS = 

BEGIN 

OPEN SWS: StarWindowShe11; 


General Items: TYPE = {IconName, channelSpeed, folderName, others}; 

Textltems: TYPE -■= {folderName, docName, 

justification, lineHeight, 
preLeading, postLeading, 
underlIning, 

guessMark, dropKeepMark, 
pageBreak, 
others}: 

Map Items: TYPE = {header, from, to}; 

Fontltenis: TYPE = {fontO, sizeO, italicsO, boldO, 
fontl, sizel, italicsl. boldl, 
font2, size2, italics2, bold2. 
font3, s1ze3, italics3, bold3, 
font4, size4, ita1lcs4, bold4, 
font5, size5, italics5, bold5, 
font6, sizeG, italics6. bold6. 
font7. size7. italics7. bold7. 
font8, size8, italics8, bold8, 
font9, size9, italics9, bo1d9}: 

IconParms: TYPE = LONG POINTER TO IconParmsRecord: 

IconParmsRecord: TYPE = RECORD[ 

heap: UNCOUNTED ZONE «■ NIL. 

propSheet: SWS.Handle *■ SWS.nul lHandle. 

iconData: Containee .DataHandle «- NIL, 

changeProc: Containee.ChangeProc *• NIL. 

changeProcData: LONG- POINTER «- NIL, 
iconFile: NSFile.Handle <- NSF 1 le . nul lHandle, 

signature: CARDINAL «• 0. 

genProps: General Properties «- NIL, 

docProps: DocumentProperties «- NIL. 

mapProps: MapProperties «- NIL, 

fonProps: FontProperties «- NIL]; 

ConvertParms: TYPE = LONG POINTER TO ConvertParmsRecord: 

ConvertParmsRecord: TYPE = RECORD [ 

zone: UNCOUNTED ZONE - NIL, 

optionSheet: SWS.Handle «- SWS. nul lHandle. 

logFile: NSF i le .Handle *■ NSFi le. nul 1 Handl e . 

docProps: DocumentProperties «* NIL, 

mapProps: MapPropert ies <- NIL, 

fonProps: FontProperties *• NIL]; 

General Properties: TYPE = LONG POINTER TO GeneralPropertyRecord: 

Genera IPropertyRecord: TYPE = RECORD [ 

iconName: XString.ReaderBody, 

channelSpeed: ChannelSpeed, 

folderName: XString.ReaderBody, 

others: XString.ReaderBody, 

tagSize: LONG POINTER TO Genera 1 TagSizes *• NIL]; 

DocumentProperties: TYPE - LONG POINTER TO DocumentPropertyRecord; 

DocumentPropertyRecord: TYPE = RECORD [ 

folderName: XString.ReaderBody, 

docName: XString.ReaderBody, 

justification: BOOLEAN. 

lineHeight: LineSpacing, 

preLeading: LineSpacing, 

postLeading: LineSpacing, 

underlining: Underlining, 

guessMark: XString.ReaderBody, 

dropKeepMark: DropKeep, 

pageBreak: PageBreak. 

others: XString.ReaderBody, 

tagSize: LONG POINTER TO TextTagSIzes *■ NIL]: 

MapProperties: TYPE = LONG POINTER TO MapPropertyRecord: 

MapPropertyRecord: TYPE = RECORD [ 

header: XString.ReaderBody, 

number: CARDINAL <- 0. 

map: Mapping «■ NIL, 

tagSize: LONG POINTER TO MapTagSizes «• NIL]; 

FontProperties. TYPE ; LONG POINTER TO FontPropertyRecord; 
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FontPropertyRecord: 
fonts: 
tagSize: 


TYPE = RECORD [ 

ARRAY [0..9] OF FontRecord, 

LONG POINTER TO FontTagSizes «■ NILj; 


Mapping: 

Mapp ingRecord: 
next: 
f row: 
to: 


TYPE = LONG POINTER TO Mapp1ngRecord; 
TYPE = RECORD [ 

Mapping *• NIL. 

XString.ReaderBody, 

XString.ReaderBody]; 


FontRecord: 

font: 
size: 
italics: 
bold: 


TYPE = RECORD [ 
FontStyle. 
FontSIze, 
BOOLEAN, 
BOOLEAN]; 


Channel Speed: 
FontStyle: 
FontSIze: 

Underlining: 
LineSpacing: 
DropKeep: 
PageBreak: 
GeneralTagSizes: 
TextTagSizes: 
MapTagSizes: 
FontTagSizes: 


TYPE = {ninetySix, fortyEight, three): -- hectobauds 
TYPE = {modern, classic, titan); 

TYPE = {eight, ten, twelve, fourteen, 
eighteen, twentyFour); 

TYPE ^ {underline, Italics, plain); 

TYPE = {single, singleHalf, double, triple); 

TYPE = {drop, keep); 

TYPE = {drop, keep, unfilled); 

TYPE - ARRAY General Items OF CARDINAL <- ALL[01; 

TYPE = ARRAY Textltems OF CARDINAL - ALL[0]; 

TYPE = ARRAY Mapltems OF CARDINAL <- ALL[0]; 

TYPE = ARRAY Fontltems OF CARDINAL - ALL[0]; 


-- Procedures implemented in K4WindowImpl 

OpenWindow: PROCEDURE [iconData: Contalnee.DataHandle, 

changeProc: Containee.ChangeProc, 
changeProcData: LONG POINTER, 
tinylcon: XString.Character] 

RETURNS [shell: SWS. Handle <- SWS. nul lHandl e] : 

PutFi1elnFo1der: PROCEDURE [file: NSFile.Handle, 

folderName: NSString.String]; 


■■ Procedures implemented in K4PSheetImpl 

OpenPSheet: PROCEDURE [iconData: Containee.DataHandle, 

changeProc: Containee.ChangeProc, 
changeProcData: LONG POINTER] 

RETURNS [SWS.Handle]; 

OpenDocOptionSheet: PROCEDURE [ 

convertParm: ConvertParms, 
takeDown: PropertySheet.MenuItemProc]; 


-- Procedures implemented in K4Fi 1 edDatalmp1 

TypeAndVersion: PROCEDURE RETURNS [fileType: NSFile.Type. 

version: Prototype.VersionJ; 

LoadFiIedData: PROCEDURE [parm: IconParms] 

RETURNS [mismatch: BOOLEAN <- FALSE]: 

StoreF iledData: PROCEDURE [parm: IconParms]: 

FreelconProps: PROCEDURE [props: GeneralProperties. 

z: UNCOUNTED ZONE]; 

FreeTextProps: PROCEDURE [props; DocumentProperties. 

z: UNCOUNTED ZONE]: 

FreeMapProps: PROCEDURE [props: MapProperties, 

z: UNCOUNTED ZONE]; 

FreeFontProps : PROCEDURE [props: FontProperties, 
z: UNCOUNTED ZONE]; 


-- Procedures Implemented in K4DocumentImpl 

ConvertroDocument: PROCEDURE[1ogFile: NSFile.Handle, 

docProps: DocumentProperties. 
mapProps: MapProperties, 
fonProps: FontProperties]; 


END. -- of K4 
14-Jan-87 14:35:51 
28-Jan-87 16:01:53 
27-Feb-87 15:56:30 

3- Mar-87 11:05:03 

4- Mar-87 15:55:03 
9-Mar-87 14:08:49 


created from DestText and KDEM3. 

changed parms of ConvertToViewPoint. 

added preliminary ConvertToCanvas. 

unified parms for ConvertToViewPoint. ConvertToCanvas. 

added PutFi1elnFolder. 

added CanvasName, IconParmRecord, CanvasParmRecord. 
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9-Mar—87 16:43:35 elimination of Courier and addition of options from linked property sheet. Changed iconFIleType because of filed props 
changes. 

13- Mar—87 10:12:24 added options and modified others. 

l0-Mar-87 9:43:17 version 9: added signature. 

17- Mar-87 13:15:28 added character mapping. 

18- Mar—87 11:04:54 defined OpenDocOptlonSheet, OpenCanvasOptionSheet. and dropped all other option sheet interfaces. 

18- Mar-87 14:22:38 version 11: preset number to 0, not 1. 

19- Mar-87 10:51:46 moved application file type and version Into proc TypeAndVersion to avoid full recompilation of all impls at every 
version change. 

31-Mar-87 12:58:48 removed IconName from StoreFiledData. 

2-Apr-87 11:26:48 added parameter saveLog to Convertfo... 

6-Apr-87 15:06:18 changed parameters of ConvertToCanvas, ConvertToDocument. 

14- Apr-87 12:56:02 added paragraph line height and leadings, added drop/keep questionable marks. 

24-Apr-87 16:08:12 dropped canvas and ArtScan processing, moved fonts to separate prop sheet. 

27-Apr-87 12:56:49 added folder of transmisions in general Items, and choice for page breaks. 

/ 
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<< file: K4DocumentImpl.mesa 


14-Sep-88 16:02:55 


Parses K4 output and produces structured data 
for input to CommonConversionlmpl 

(which makes a Viewpoint document from the structured data) 
Owner: Advanced Design - User Interfaces - deLaBeaujardiere >> 


DIRECTORY Ascii, BackgroundProcess, 

DocInterchangeDefs, DocInterchangePropsDefs, 

FormWindow, Heap, K4, NSFile, NSFileStream, 

NSString, 

Process, PropertySheet, 

Runtime, StarFileTypes, 

StarWindowShel1. Stream, Window, 

XChar, XCharSetO, XCharSet360, XString; 

K4DocumentImpl: PROGRAM 
IMPORTS BackgroundProcess, 

DocInterchangeDefs, Doc!nterchangePropsDef$, FormWindow, Heap, K4, 
NSFile, NSFileStream, NSString, 

Process, PropertySheet, Runtime, 

Stream, 

XChar, XCharSetO, XCharSet360, XString 
EXPORTS K4 
SHARES XString = 

BEGIN 

OPEN DI: DocInterchangeDefs, DIP: DocInterchangePropsDefs, 

FW: FormWindow, XS: XString: 


Baseline: TYPE = {null, super, sub}; 

QuestionHandling: TYPE = {keep, dropCharacter, dropstring}: 

Line: TYPE = LONG POINTER FO LineRecord; 

LineRecord: TYPE = RECORD [ 

next: Line^NIL, 

chunk: Chunk *- NIL, 

interLine: CARDINAL, -- empty lines above 

1eadingSpaces: CARDINAL, 
paragraphHere : BOOLEAN <- FALSE, 
text: XS.WriterBody]; 

Chunk: TYPE = LONG POINTER TO ChunkRecord 

ChunkRecord: TYPE = RECORD [ 

next: Chunk *• NIL, 

aspect: Aspect *■ plain, 

firstChar: CARDINAL *■ 0, 

nChars : CARDINAL <- 0]; 

Aspect: TYPE = MACHINE DEPENDENT { 

notAnAspect, plain, 
onSubscript, offSubscript, 
onSuperscript, offSuperscript, 
onUnderline, offUnderlIne, 

onFontO, (9), -- avoid TAB 

onFontl. onFont2, (12), (13), -- avoid FF and CR 

onFont3, onFont4, onFont5, onFontB, 
onFont7, onFont8, onFont9, 
offFontO, offFontl, offFont2, offFont3, 
offFont4, offFontS, (27), -- avoid ESC 

offFont6, offFont7, offFont8, offFont9}: 

-- the above enumeration is to replace in the source 
-- stream the font/underline/subscript/., markers 
-- with characters that cannot be accessed through 
-- the keyboard or are not K4 encodings. 

- Thus the mapping options typed by 
-- the user cannot interfere with the markers. 

ConversionHandle: TYPE = LONG POINTER TO ConversionData: 

ConversionData: TYPE = RECORD [ 
docHandle: DI.Doc, 

fontProps: DIP.FontPropsRecord. 

paraProps: DIP,ParaPropsRecord, 

pageProps: DIP.PagePropsRecord, 

tabProps: ARRAY [0,.maxTabs) OF DIP.TabStop]: 

WarningLines: TYPE = [0..10); 


tab: 
space: 

1astlnSetO: 
hyphen: 
questionMark: 
substitute: 
paraTab: 
pageEnd: 

1 ineEnd: 
propsBegin: 
propsEnd: 
subscript: 
superscript 
underl1ne: 
fontStyleO: 


XChar.Character = XCharSetO.Make [tab]: 

XChar.Character = XCharSetO.Make [space]; 

XChar.Character = XCharSetO.Make [lowerEng]; 

XChar.Character = XCharSetO.Make [minus]; 

XChar.Character = XCharSetO.Make [questionMark]; 

XChar.Character = XCharSet360,Make [blackRectGraph ic]; 
XChar.Character = XCharSetO.Make[LGQPHOLE[211C]]; 
XChar.Character = XCharSetO.Make[LOOPHOLE[014CJ]; 

XChar.Character = XCharSetO.Make[LOOPHOLE[015C]]; 
XChar.Character = XCharSetO.Make[LOOPHOLE['<.ORD]]; 
XChar.Character = XCharSetO.Make[LOOPHOLE['>.ORD]]; 
XChar.Character = XCharSetO.Make[LOOPHOLE['i.ORD]]; 
XChar.Character = XCharSetO,Make[LOOPHOLE['s.ORD]]; 
XChar.Character = XCharSetO.Make[LOOPHOLE[*u.ORD]]; 
XChar.Character = XCharSetO.Make[LOOPHOLE['0.ORD]]; 


-- pointer to beginning position 
-- number of characters 
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fontStyle1 
fontSty1e 2 
fontStyle3 
fontStyle4 
fontSty1e5 
fontStyle6 
fontStyle7 
fontStyle8 
fontSty!e9 
escape: 


XChar.Character 
XChar.Character 
XChar.Character 
XChar.Character 
XChar.Character 
XChar.Character 
XChar.Character 
XChar.Character 
XChar.Character 
XChar.Character 


XCharSetO.Make[LOOPHOLE['1.0RD]] 
XCharSetC.Make[LOOPHOLE[’2.ORO]] 
XCharSetO,Make[LOOPHOLE['3.ORD]] 
XCharSetO.Make[LOOPHOLE['4.ORO]] 
XCharSetO.Make[LOOPHOLE[ 1 5.ORO]] 
XCharSetO.Make[LOOPHOLE['6.ORO]] 
XCharSetO.Make[LOOPHOLE['7.ORD]] 
XCharSetO.Make[LOOPHOLE[*8.ORD]] 
XCharSetO.Make[LOOPHOLE['9.ORD]] 
XCharSetO.Make[LOOPHOLE[033C]]: 


onelnch: 
spaceWidth: 
maxTabs: 

fourthlnch: 
f i velnches: 

1 inesFor8Inches: 
pointsPerline: 


CARDINAL » 1440; 

CARDINAL = onelnch / 10; 

CARDINAL =8; --8 arbitrary tabs 

-- half an inch apart 
CARDINAL = onelnch / 4; 

CARDINAL = onelnch * 6; 

CARDINAL = 48; -- 6 lines per inch 

CARDINAL = 12;. 


X 



ConvertToDocument: PUBLIC PROCEDURE [ 

logFile: NSFile.Handle, 
doc Props : K4 .DocumentProperti.es , 
mapProps: K4.MapProperties. 
fonProps: K4 . FontProperties] = 


BEGIN 

-- This procedure copies the parameters in a record 

-- of its own. so that the original can be freed by the client. 

-- It then paints either an option sheet 

or a warning sheet requesting that Interpress be loaded. 

--- Control returns to client as soon as the sheet is painted. 

-- Zone and nodes acquired here are freed by ReleaseParm. 

ownZone: UNCOUNTED ZONE *■ Heap .Create[ 1] ; 

cp: K4.ConvertParms «* ownZone .NEW[K4.ConvertParmsRecord] ; 

source, sink, map: K4.Mapping «■ NIL; 

cp.zone *- ownZone; 
cp . 1 ogFi 1 e «- 1 ogF i 1 e ; 

cp.docProps *■ ownZone .NEW[K4.DocumentPropertyRecord] ; 
cp.docProps* «- docPropst; 

cp .docProps.folderName «■ XS .CopyToNewReaderBody[ 

@docProps.folderName, cp.zone]; 
cp. docProps .docName <- XS.CopyToNewReaderBody[ 

©docProps.docName, cp.zone]; 
cp . docProps .guessMark *■ XS .CopyToNewReader*Body[ 

©docProps.guessMark, cp.zone]; 
cp . docProps .others *• XS.CopyToNewReaderBodyf 

©docProps.others, cp.zone]; 

cp.mapProps «■ ownZone,NEW[K4.MapPropertyRecord] ; 

cp .mapProps .header *■ XS.CopyToNewReaderBody[@mapProps.header. cp.zone]; 
cp .mapProps . number «- mapProps . number ; 
source *• mapProps .map ; 

FOR k: CARDINAL IN [1..mapProps.number] DO 
map <- cp.zone.NEW [K4.MappingRecord *• [ 

from: XS.CopyToNewReader8ody[@source.from, cp.zone], 
to: XS.CopyToNewReaderBody[@source.to. cp.zone], 

next: NIL]]; 

IF cp.mapProps.map = NIL 

THEN cp .mapProps .map «■ map 
ELSE sink.next map; 
sink *• map; 
source *■ source.next; 

ENDLOOP; 

cp.fonProps *■ ownZone . NEW[K4. FontPropertyRecord] ; 
cp.fonProps* «* fonProps*; 

IF Runt ime.IsBound [LOOPHOLE [DI.StartCreation]] 

THEN K4.OpenDocOptionSheet [cp, TakeDownSheet] 

ELSE ShowWarning [cp]; 

END; -- of ConvertToDocument 


TakeDownSheet: PropertySheet.MenuItemProc = 

BEGIN 

cp: K4 .ConvertParms «• LOOPHOLE[cl ientData]; 

IF menuItem - start 

THEN Process.Detach [FORK ConvertProcess[cpj] 
ELSE ReleaseParm [cp]; 
ok ** TRUE; 

END; -- of TakeDownSheet 


ShowWarning; PROC [cp; K4.ConvertParms] = 

BEGIN 

pSheetName: XS.ReaderBody «- XS.FromSTRING ["Kurzweil Converter"L] ; 
pSize: Window.Dims «- [420, 300]; 
pPlace: Window.Place *• [550, 100]; 
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[] <- PropertySheet.Create [formWindowI terns : MakeWarning, 

formWindowItemsLayout: Layoutwarning, 

menuItemProc: Exitwarning, 

menultems: [done; TRUE, cancel: TRUE], 

title: OpSheetName, 

size: pSize, 

piaceToDisp1 ay: pPlace, 

clientData: cp]; 

END; -- of ShowWarning 


MakeWarning: FW.MakeltemsProc = 

BEGIN 

txt: ARRAY WarningLines OF LONG STRING [ 

"VP Editor is needed to make a document, but is not running."L, 
"Please run the following applications (if they are idle,"L. 
"then press <Done>:"L, 

" Font Manager"L, 

" Workstation Keyboards'^, 

" Keyboards'^, 

" Interscript Converter"L, 

VP Document Editor"L. 

" "L, 

"If want to drop the document creation, press <Cancel > , J 'L]; 
msg: XString.ReaderBody; 

FOR k: WarningLines IN WarningLines DO 
msg «- XString . FromSTRING[txt[k]] ; 

FW.MakeTextltem [window: window, myKey: k, 

tag: NIL, readonly: TRUE, boxed: FALSE, 
width: 400, initString: @msg]: 

ENDLOOP; 

END; -- of MakeWarning 


Layoutwarning: FW.LayoutProc - 
BEGIN 

FOR k: WarningLines IN WarningLines DO 

line: FW.Line *■ FW. AppendLi ne [window: window, spaceAboveLine: 0]; 
FW.Appendltem [window: window, item: k, 

line: line, preMargin: 10]; 

ENDLOOP: 

END; -- of LayoutWarning 


ExitWarninq: PropertySheet.MenuItemProc = 

BEGIN 

cp: K4. ConvertParms «- LOOPHOLE[cl ientData] : 
newMsg: XString .ReaderBody *• XStri ng. FromSTRING[ 

"The Document Editor is still not running..."L]: 

IF menultem = cancel THEN 
BEGIN 

ReleaseParm [cp]; 

RETURN [TRUE]: 

END; 

IF Runtime.IsBound[LOOPHOLE[DI.StartCreation]] THEN 
BEGIN 

K4.OpenDocOptionSheet [cp, TakeDownSheet]; 

RETURN [TRUE]; 

END; 

FW.SetTextltemValue [formWindow, 0, QnewMsg, TRUE]; 
RETURN [FALSE]; 

END; -- of ExitWarning 


ConvertProcess: PROCEDURE [cp: K4.ConvertParms] = 

BEGIN 

processName; XS.ReaderBody «■ XS.FromSTRING["Making Document"L]; 

ManagedProcess: BackgroundProcess.Cal 1BackProc = 

-- ManagedProcess must be within ConvertProcess 
-- to be supervised by the Background Processor 

BEGIN 

ENABLE UNWIND => (finalStatus <■ aborted: CONTINUE): 


zone: UNCOUNTED ZONE *• cp.zone; 

rawText: XS.WriterBody; 

firstLine, currentLine: Line <• NIL; 

line: Line; 

map: K4,Mapping *■ NIL; 

maxMapLength: CARDINAL *■ 0; 

leadingSpaces: CARDINAL; 

emptyLinesAbove : CARDINAL *- 0; 

conversionHandle: ConversionHandle; 

docFile: NSFile.Handle; 

docSession: NSFile.Session; 

status: DI.FinishCreationStatus: 

docNSName, folderNSName: NSString.String; 

docAttributes: ARRAY [0..1) OF NSFile.Attribute: 

logStream: Stream.Handle; 

hasProps, endOfPage, endOfStream: BOOLEAN «- FALSE; 

qHandling: Quest ionHandling; 

qCharacter: XS.Character; — accelerator 

qString: XS.Reader; -- accelerator 
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conversionHandle <- BeglnDocument [zone, cp .docProps, cp . fonProps]: 
IF conversionHandle = NIL THEN RETURN; -- creation failed 

IF (cp.mapProps ft NIL) 

AND (cp .mapProps .map ft NIL) 

AND (NOT XS.Empty [@cp.mapProps.map.from]) THEN 

[map, maxMapLength j *• OrderMap [cp .mapProps .map] ; 

qString *- ©cp.docProps.guessMark; 

SELECT TRUE FROM 

cp .docProps. dropKeepMark = keep => qHandling *■ keep; 
XS.CharacterLength[qString] = 1 => 

BEGIN 

qHandling «- dropCharacter; 
qCharacter «- XS . Lop[qStri ng] ; 

END; 

ENDCASE = > qHandling «- dropstring; 

logStream «- NSFi 1 eStream.Create [cp. logFile, FALSE]; 

Stream.SetlnputOptions [logStream, [signalEndOfStream: TRUE]]; 

rawText *• XS.NewWriterBody [300, zone]; 

-- large enough to contain a whole line 
- in small font. Will be expanded ifneeded. 


DO 

--- get a raw line of text 

[leadingSpaces, hasProps, endOfPage, endOfStreamJ *• FillBuffer [ 
logStream, ©rawText, 
qHandling, qCharacter, qString]; 

IF XS.Empty [XS.ReaderFromWriter[@rawText]] THEN 
emptyLinesAbove «- emptyLinesAbove +■ 1 
ELSE 
BEGIN 

line *■ zone.NEW [LineRecord]; 

IF firstLine = NIL THEN currentLine firstLine «■ line 
ELSE currentLine «- currentLine.next *- line; 

1 ine . leadingSpaces <- leadingSpaces; 

1 i ne . i nte rLi ne *■ emptyLinesAbove; 

emptyLinesAbove *- 0; 

line, text «■ XS .CopyToNewWriterBody[ 

XS.ReaderFromWr1ter[@rawText], zone] ; 

IF map ft NIL THEN Map [XS.ReaderFromWriter[@rawText], ©line.text, map]; 

IF hasProps THEN Parcel [line, zone]; 

END; 

IF endOfPage THEN -- end of page found after current line 
BEGIN 

linesInPage: CARDINAL *■ Fi 1 IDocument [conversionHandle, firstLine, 

cp. fonProps, 

cp .docProps.underlining]; 

SELECT cp.docProps.pageBreak FROM 
drop => NULL; 

keep => DI.AppendPageBreak [conversionHandle.docHandle, 

©conversionHandle.fontProps]; 
unfilled => IF linesInPage < 11nesFor8Inches THEN 

DI.AppendPageBreak [conversionHandle.docHandle, 

©conversionHandle.fontProps]; 

ENDCASE; 

ReleaseLines [firstLine, zone]; 
f i rstLine <- NIL; 
emptyLinesAbove *■ 0; 

END; 

IF endOfStream THEN EXIT; -- end of stream found after current line 

ENDLOOP; -- loop to get next raw line 

[] Fill Document [conversionHandle, firstLine, 

cp.fonProps, cp.docProps.under!ining]; 

ReleaseLines [firstLine, zone]; 

[docFile. docSession, status] *■ DI. FinishCreat ion[©convers ionHandle. docMandl e] 

IF docFile ft NSFIle,nullHandle THEN 

BEGIN -- reopen docFile in null session 

ENABLE NSFile.Error => 

{ 

NSFi1e,Close[docFi1e, docSession ! NSFile.Error => CONTINUE]; 
docFile «- NSFile . nullHandle ; 

CONTINUE; 

}: 

tmpRef: NSF i 1 e . Reference *■ NSF11e .GetReference[file: docFile, 

session: docSession]; 

tmpFile: NSFile .Handle *■ docFile; 

docFile *• NSFile,OpenByReference[reference: tmpRef]; 

NSFile,Close[tmpF ile, docSession]; 

NSFile.Logoff[docSes$lon ! NSFile.Error => CONTINUE]; 

END; 

docNSName «■ XS.NSStringFromReader [ 

©cp.docProps.docName. zone]; 
docAttributes[0] *■ [name[docNSName]]; 

NSFi1e.ChangeAttributes [docFile, DESCRIPTOR [docAttributes]]; 

NSString.FreeString [zone, docNSName]; 


K4DocumentImp1.mesa 


14-Sep-88 16:02:56 PDT 



folderNSName *■ XS.NSStringFromReader [ 

@cp.docProps.folderName, zone]; 
K4,PutFileInFolder [docFile, folderNSName]; 

NSString. F reeString [zone, folderNSName]; 

NSFile.Close [docFile]; 

Stream.Delete [logStream]; 

XS.FreeWriterBytes [QrawText]; 

ReleaseParm [cp]; -- done last, beause it releases the zone 

END; -- of ManagedProcess 

Process.SetPriority[Process.priorityBackground]; 

L] BackgroundProcess . ManageMe[name : QprocessName , 

cal 1BackProc: ManagedProcess, 
abortable: FALSE]; --*+ TRUE later 

END; -- of ConvertProcess 


FillBuffer: PROC [stream: 

bufferW: 
qHandling: 
qCharacter: 
qString: 

RETURNS [1eadingSpaces: 
hasProps: 
endOfPage: 
endOfStream: 

BEGIN 

-- Gets a line of text in buffer, 

-- Drops the leading spaces. 

-- Replace strings of 3 or more spaces by a tab. 

-- Replaces props marker by ESC+code so that they cannot be 
-- changed by user mapping options. 

ENA8LE Stream.EndOfStream => GOTO EndStream; 
xChar, yChar: XChar.Character; 
aspect; Aspect; 
i ns ideSpaces, k: CARDINAL: 


Stream.Handle, 

XS.Writer, 
QuestionHandling, 
XS.Character, 

XS.Reader] 

CARDINAL «- U, 
BOOLEAN <- FALSE. 
BOOLEAN <- FALSE. 
BOOLEAN <- FALSE] = 


up to next CR or FF. 


NextChar: PROC RETURNS [XS.Character] = INLINE 

{RETURN [XCharSeLO.Make[LOOPHOLE[Stream.GetByte [stream]]]]}; 

XS.ClearWriter [bufferW]: 
i ns ideSpaces «• 0; 


DO -- count and drop leading spaces 

xChar «- NextChar[]; 

IF xChar ff space THEN EXIT; 
leadingSpaces «• leadingSpaces + 1; 

EMDLOOP; 


DO -- get remainder of line 

SELECT TRUE FROM 

xChar « lineEnd => RETURN; 

xChar = pageEnd => {endOfPage «■ TRUE; RETURN}: 

qHandllng = dropCharacter 

AND xChar = qCharacter => NULL; 

xChar = propsBegin => -- replace begin-props markers 

BEGIN 

yChar * NextChar[]; 
aspect «- SELECT yChar FROM 
underline => onUnderline, 
subscript => onSubscript, 
superscript => onSuperscript. 
fontStyleO => onFontO, 
fontStylel => onFontl, 
fontStyle2 => onFont2, 
fontStyle3 => onfont3, 
fontStyle4 s > onFont4, 
fontStyleS => onFontS, 
fontStyle6 => onFontB, 
fontStyle7 => onFont7, 
fontStyleB => onFont8, 
fontStyle9 => onFont9, 

ENDCASE = > notAnAspect; 

IF aspect = notAnAspect THEN 

(XS.AppendChar [bufferW, xChar]; 

XS.AppendChar [bufferW, yChar]} 

ELSE 

[XS.AppendChar [bufferW, escape]; 

XS.AppendChar [bufferW, 

XCharSetO.Make[LOOPHOLE[aspect]]]; 
hasProps «- TRUE}; 

END; 

xChar - propsEnd > -- replace end-props markers 

BEGIN 

yChar *• MextChar[]; 
aspect *■ SELECT yChar FROM 
underline -> offUnderl ine , 
subscript => offSubscript, 
superscript => offSuperscript, 
fontStyleO => offFontO, 
fontStylel -> offFontl, 
fontStyle2 => offFont2, 
fontStyle3 => offFont3, 
fontStyle4 => offFont4, 
fontStyle5 => offFontS, 
fontStyle6 -> offFont6, 
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fontStyle7 => offFont7, 
fontStyle8 => offFont8, 
fontStyle9 => offFont9, 

ENDCASE => notAnAspect; 

IF aspect = notAnAspect THEN 
{XS.AppendChar [bufferW, xChar]; 

XS.AppendChar [bufferW. yChar]} 

ELSE 

{XS.AppendChar [bufferW. escape]: 

XS.AppendChar [bufferW, 

XCharSetO.Make[LOOPHOLE[aspect]]]; 
hasProps «- TRUE}; 

END; 

xChar = space => insideSpaces *■ InsIdeSpaces + 1; 

-- count embedded spaces 
xChar IN (space..lastlnSetO] a > 

BEGIN 

-- replace space strings by tab or space 
SELECT insideSpaces FROM 
0 => NULL; 

>5 => XS.AppendChar [bufferW. tab]; 

ENDCASE => 

BEGIN 

FOR k IN [1..insideSpaces] DO 
XS.AppendChar [bufferW, space]; 

ENDLOOP: 

END; 

XS.AppendChar [bufferW, xChar]: 
insideSpaces «- 0: 

END; 

xChar = tab ==> 

XS.AppendChar [bufferW. xChar]; 

ENDCASE => 

XS.AppendChar [bufferW, substitute]; 

-- ** handle questionable char "dropstring" later 

xChar *■ NextChar []; 

ENDLOOP; 

EXITS EndStream => {endOfStream *- TRUE); 

END; -- of FilIBuffer 


Parcel; PROC [line: Line, zone: UNCOUNTED ZONE] = 

BEGIN 

-- Font or aspect markers found in line.text generate 
-- a linked list of "chunks". 

There is at least one marker when we enter this proc. 


code: 
index: 
source: 
newChunk: 
currentChunk: 


XChar.Character; 

CARDINAL > 0; 

XS.Reader *■ XS.ReaderFromWriter[@l ine. text] ; 
Chunk <- NIL; 

Chunk «- zone.NEW [ChunkRecord]; 


line.chunk *- currentChunk; 


WHILE index < XS.ByteLength[source] DO -- parse source text 

code «- XS.NthCharacter [source, index]; 

IF code # escape THEN 
BEGIN 

index «• index + 1; 

END 

ELSE 

8EGIN 

currentChunk.nChars «■ Index - currentChunk.firstChar; 

-- Make a new chunk, unless the current chunk is at beginning of line. 
IF index > 0 THEN 
BEGIN 

newChunk «• zone.NEW [ChunkRecord]; 
currentChunk.next *• newChunk; 
currentChunk *• newChunk; 

END; 

code «■ XS.NthCharacter [source, index + 1]; 
currentChunk.aspect *■ LOOPHOLE[XChar.Code[code], Aspect]; 
index <- index + 2; 
currentChunk.firstChar *■ index; 

END; 

ENDLOOP: 

currentChunk. nChars *■ index - currentChunk.f irstChar: 

END: -- of Parcel 


ReleaseLines: PROC [firstLine: Line, z: UNCOUNTED ZONE] = 
BEGIN 

line: Line «■ firstLine; 
holdLine: Line *■ NIL; 
chunk, holdChunk: Chunk <- NIL: 

DO 

IF line = NIL THEN RETURN; 
chunk «- line.chunk; 

DO 

IF chunk = NIL THEN EXIT; 
holdChunk «- chunk.next; 
z.FREE [©chunk]; 
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chunk «• holdChunk; 

ENDLOOP; 

XS.FreeWriterBytes [@1ine.text] ; 
holdLine *• line.next; 
z.FREE [@1ine]; 
line «- holdLine; 

ENDLOOP; 

END; -- of ReleaseLines 


ReleaseParm: PROC [cp: K4.ConvertParms] = 
BEGIN 

z: UNCOUNTED ZONE *• cp.zone; 

NSFile.Close [cp.1ogFile] ; 

K4.FreeTextProps [cp.docProps, z]; 

K4.FreeMapProps [cp.mapProps, z]; 

K4.FreeFontProps [cp.fonProps, z]; 
z.FREE [@cp]: 

Heap.Delete [z]; 

END; -- of ReleaseParm 


BeginDocument: PROCEDURE [z: UNCOUNTED ZONE. 

docProps: K4.OocumentProperties. 
fonProps; K4.FontPropertles] 

RETURNS [document: LONG POINTER] - 

BEGIN 

h: ConversionHand Ie *• z.NEW [ConversionData] : 

DIP.GetPagePropsDefaults[@h .pageProps]; 

DIP.GetFontPropsDefauIts[@h .fontProps]; 

h.font.Props.f ontDesc .po i ntSize *■ 

SELECT fonProps.fonts[0].size FROM 

twelve => 12, 
ten => 10. 
eight => 8. 

fourteen => 14. 

ENDCASE => 12: 

h. fontProps . fontDesc .weight «- IF fonProps . fonts[0] .bold 
THEN bold ELSE medium; 

h.fontProps.fontDesc,designVariant IF fonProps . fonts[ 0 ] . i tal ics 
THEN italic ELSE roman; 

h . fontProps . fontDesc . fami ly *■ 

SELECT fonProps.fonts[0].font FROM 

classic => century, 
modern =>.frutiger, 
ENDCASE => titan; 


DIP.GetParaPropsDefaults[@h.paraProps]; 

h . paraProps .basicProps .preLeading *- SELECT docProps .preLeading FROM 

single => 0, 
singleHalf => 6, 
double => 12. 

ENDCASE => 24; 

h . paraProps .basicProps .postLeading «■ SELECT docProps .postLeading FROM 

single => 0, 

SingleHalf => 6. 
double => 12. 

ENDCASE => 24; 

h .paraProps .basicProps . 1 ineHeight «- SELECT docProps . 1 ineHeight FROM 

single => 12 , 
singleHalf => 18, 
double => 24. 

ENDCASE => 36: 

h.paraProps.basicProps.just ified «- docProps .justif ication; 

h . paraProps , tabStops «- DESCRIPTOR [h . tabProps] ; 

FOR k: CARDINAL IN [0..maxTabs) DO -- set 12 tabs at 1/2 inch 

h . tabProps[k]. dotLeader <- FALSE; 

h. tabProps[k] . tabStopOffset «• 36 * k; -- 72 points/inch 

h . t.abProps[k] . tabStopAl ignment *■ left; 

ENDLOOP; 

[h. docHandl e, ,, , . ] «- DI. StartCreation [ 

simple. -- simple pagination 
FALSE, -- no header 
FALSE. -- no footer 
@h. fontProps, 

0h.paraProps, 

Qh.pageProps]; 

document *■ h; 

END; -- of BeginDocument 


FillDocument: PROC [h; ConversionHandle, 

1 ineList: Line, 

fontOptions: K4.FontProperties. 
underOption: K4.Underliningj 
RETURNS [1 inesInPage; CARDINAL «• 0] = 

BEGIN 


partialBody; 
fu1IReader: 
context: 
line: 
lastChar: 


XS.ReaderBody; 

XS.Reader; 

XS.Context ♦* XS.vanl 1 laContext; 
Line; 

XChar.Character; 
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IF 1inelist = NIL THEN RETURN; 


MarkParagraphs [lineList, FALSE]; 

-- Find the paragraph boundaries 

FOR line *■ lineList. line.next WHILE line ¥ NIL DO 

linesInPage - linesInPage + 1 + 1ine.interLIne; 

-- count to see where is the last line in the page; 

-- if it lies "far up enough" from the bottom 
-- (arbitrarily, 3" from bottom. 8" from top). 

-- we will issue a page break. 

IF 1ine.paragraphHere THEN 
BEGIN 

h. f ontProps . nUnderl i nes *■ 0; -- turn off underline at 

-- beginning of a paragraph 

FOR k: CARDINAL IN [2..1ine.interLine) DO -- make white space 
DI.AppendNewParagraph [[doc[h.docHandle]], 

@h.paraProps, 

@h.fontProps]; 

ENDLOOP; 

DI.AppendNewParagraph [[doc[h.docHandle]], 

@h.paraProps. @h.fontProps]; 

END; 

fullReader «- XS.ReaderFromWriter[@l ine. text] ; 

IF line.chunk = NIL THEN 
BEGIN 

DI.AppendText [[doc[h.docHandle]]. fullReader, 

XS.vani11aContext. @h.fontProps]; 

END 

ELSE 

BEGIN 

FOR chunk; Chunk «- line.chunk, chunk.next WHILE chunk ¥ NIL DO 
SetAspect [chunk, fontOptions, underOption, @h.fontProps]: 

IF chunk.nChars > 0 THEN 
BEGIN 

[partialBody. context] «• XS.Piece [fullReader, 

chunk.fIrstChar, 
chunk.nChars]; 

DI.AppendText [[doc[h.docHandle]], 

@partialBody, context. Oh.fontPropsl; 

END; 

ENDLOOP; -- loop to process next chunk in line 
END: 

-- Put a space after the last character of the line 
-- unless there is already a space or an hyphen. 
lastChar «- XS.NthCharacter [fullReader, 

XS.CharacterLength[ful1 Reader] - 1]; 
IF lastChar ¥ space AND lastChar ¥ hyphen THEN 

DI.AppendChar [[doc[h.docHandle]], space, @h.fontProps]; 
ENDLOOP: -- loop to process next line 

END; -- of FillDocument 


SetAspect: PROC [chunk: Chunk. 

fontOptions: K4.FontProperties. 
underOption; K4.Underlining, 
vpFont: DIP.FontProps] = 

BEGIN 

-- Given a chunk of text with an aspect code, 

-- and given the font choices made by the user. 

-- adjust a property of the VP font as required. 

SetFont: PROC [fontChoice: K4.FontRecord] = 

BEGIN 

vpFont.fontDesc.family *■ SELECT fontChoice.font FROM 
classic => century, 
modern => frutiger, 
titan => titan, 

ENDCASE => century; 

vpFont.fontDesc.weight *■ IF fontChoice.bold 

THEN bold ELSE'medium; 

vpFont .fontDesc.designVariant «- IF fontChoice . ital ics 
THEN italic ELSE roman; 

vpFont.fontDesc.poIntSize «■ SELECT fontChoice.size FROM 
twelve => 12. 
ten => 10, 

eight 8, 

fourteen => 14, 

ENDCASE => 12; 

IF fontChoice.font = titan THEN 

BEGIN 

vpFont. fontDesc .designVariant «- roman; — in case it was italics 

IF vpFont.fontDesc.pointSize < 10 THEN 

vpFont .fontDesc .poIntSize *- 10 ; 

IF vpFont.fontDesc.pointSize > 12 THEN 

vpFont. fontDesc .pointSize *■ 12 ; 

END; 

END; -- of SetFont 

SELECT chunk.aspect FROM 

onSubscript => vpFont. placement *■ sub; 
offSubscript ?> vpFont .placement null; 
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onSuperscript 
offSuperscript 
onUnderline 


offUnderlIne 


onFontO 

onFontl 

onFont2 

onFont3 

onFont4 

onFontG 

onFont6 

onFont7 

onFont8 

onFont9 

ENDCASE 


= > vpFont.placement <• super; 

= > vpFont.placement <- null: 

3 > SELECT underOption FROM 

underline => vpFont. nUnderl ines *■ 1; 
italics => {vpFont. nUnderl ines «- 0; 

vpFont.fontDesc.designVariant «- italic} 
plain => vpFont. nUriderl ines *■ 0 : 

ENDCASE; 

=> SELECT underOption FROM 

underline => vpFont. nUnderl i nes «- 0 ; 
italics => {vpFont. nUnderl ines *- 0 ; 

vpFont. fontDesc. designVariant *■ roman} 
plain => vpFont. nUnderl ines «- 0 ; 

ENDCASE; 

= > SetFont [fontOptions.fonts[ 0 ]]; 

=> SetFont [fontOptions.font$[l]]; 

=> SetFont [fontOptions.fonts[2]]; 

=> SetFont [fontOptions.fonts[3]]; 

=> SetFont [fontOptions.fonts[4]]; 

=> SetFont [fontOptions.fonts[5]]; 

=> SetFont [fontOptions.fonts[6]]; 

=> SetFont [fontOptions.fonts[7]]; 

=> SetFont [fontOptions.fonts[8]]; 

=> SetFont [fontOptions.fonts[9J]; 

= > SetFont [fontOpt ions.fonts[0]]; -- restore font 0 


ENO; -- of SetAspect 


Map^-OC [fromR; XS.Reader, toW; XS.Writer, mapOptions: K4.Mapping] 

fromlndex: CARDINAL «- 0; 

fromMapLg: CARDINAL; 

piece: XS.ReaderBody; 

context: XS.Context; -- not used... 

XS.ClearWriter [toW]; 

WHILE fromlndex < XS.CharacterLength [fromR] DO 

FOR map: K4.Mapping «- mapOptions. map.next WHILE map H NIL DO 
fromMapLg <- XS.CharacterLength [Swap, from]; 

[piece, context] «- XS.Piece [fromR, fromlndex. fromMapLg]; 

IF XS.Equal [Opiece. @map.froml THEN 
BEGIN 

XS.AppendReader [toW, Gmap.to]: 
fromlndex fromlndex + fromMapLq; 

EXIT; 

END; 

REPEAT 

FINISHED => BEGIN -- no mapping match 

XS.AppendChar [toW, XS.NthCharacter [fromR. fromlndex]]; 
fromlndex «• fromlndex + 1; 

END; 

ENDLOOP; 

ENDLOOP; 

END; — of Map 


OrderMup: PROC [map: K4.Mapping] RETURNS [K4.Mapping, CARDINAL] = 
BEGIN 

-- This procedure sorts the mapping entries by string length, 

-- placing the longest string first. 

The sort technique is a bit crude, because we don't have 
back pointers, but the lists are generally short. 

prior, current, next, hold: K4.Mapping *• NIL; 
entryHasMoved: BOOLEAN <- FALSE; 

TF map = NIL THEN RETURN [NIL, 0]; 

«** not working correctly yet 
entryHasMoved «• TRUE; 

WHILE entryHasMoved DO 
entryHasMoved «■ FALSE; 
prior «- current «■ map; 
next *■ map.next; 

DO 

IF next = NIL OR current = NIL THEN EXIT; 

IF XS.ByteLength [Onext.from] > 

XS.ByteLength [Qcurrent.from] THEN 
BEGIN 

IF current = prior THEN 
BEGIN 

map *- next; 

map.next *■ current; 

current.next «- next.next; 

END 

ELSE 

BEGIN 

hold «- prior.next; 
prior.next «- current.next; 
current. next *■ next.next; 
next.next *■ hold; 

END; 

entryHasMoved «- TRUE; 

EXIT; 
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END; 

prior <- prior.next; 
current <- current .next: 
next «■ next, next; 

ENDLOOP; 

ENDLOOP; 

**» 

RETURN [map, 10]; --**10 Is temp... 

END; -- of OrderMap 


MarkParagraphs: PROC [firstLine: Line, 

keepLlneBreak: BOOLEAN] = --** unused for now 

BEGIN 

We think there Is a paragraph if one of the following is true: 
-- 1) the line has an interval (i.e distance from line above) 
greater than the smallest line interval: 

-- 2) the line above is "clearly" shorter than the current line, 
("clearly" arbitrarily defined as 1 inch). 

- - 3) the line is "clearly" Indented from the prior line's, 
("clearly" arbitrarily defined as 1/4 inch). 

line: Line: 

priorMargin, smal lestMargin : CARDINAL <- LAST[CARDINAL]; 

priorLength, lineLength: CARDINAL; 

smal lestlnterl ine: CARDINAL «- LAST[CARDINAL] ; 

LineLength: PROC [r: XS.Reader] RETURNS [length: CARDINAL] = 

BEGIN 

length «- XS.Character-Length [r] * onelnch / 10; 

-- Grossly approximative. Need better way... 

END: -- of LineLength 

If we must keep line breaks, no point looking further... 

IF keepLineBreak THEN 
BEGIN 

FOR line <- firstLine, line-.next WHILE line ¥ NIL DO 
1 i ne . paragraphHere «■ TRUE; 

ENDLOOP: 

RETURN; 

END; 

-- Find the smallest line interval, to tell us if 

-- the text is generally singlespaced, or double-spaced, etc.. 

-- and find the smallest left margin. 

FOR line «■ firstLine, line.next WHILE line ¥ NIL DO 

smal 1 estlnterl ine «- MIN [smal 1 estlnterl i ne . 1 ine . interLine] ; 
smal lestMargin «• MIN [smal lestMargin , I ine . leadingSpaces]: 
ENDLOOP; 

pr iorLength «- LineLength [XS.ReaderFromWriter[@firstLine.text]]; 

FOR line «- firstLine.next, line.next WHILE line ¥ NIL DO 
lineLength <- LineLength [XS .ReaderFromWri ter[@l ine. text]]; 

1 i ne . paragraphHere *■ 

(line.interLine > smallestlnterline) 

OR (priorLength *• onelnch < lineLength) 

OR (1ine.leadingSpaces > priorMargin + fourthlnch) 

OR (1ine.paragraphHere); -- already a paragraph 

priorLength «• lineLength: 
priorMargin «■ 1 ine. leadingSpaces: 

ENDLOOP; 

END; -- of MarkParagraphs 


END. -- of K4DocumentImpl 

3:28 upgraded to new version of CommonConversion, and to new parameter for ConvertToDocument. 
d auto creation of folder, movement of document into folder. 

18-Feb-87 17:51:47 added NIL header/footer parameters for BeginDocument. 

adapted to new common parameters for ConvertToDocument and ConvertToCanvas. 
added presetting of fontCholces to user options, 
adapted to linked pSheet. 

17:41:42 moved here from K4W1ndowImpl the test for Editor loaded. 

10:25:11 forgot to call SetTextOptions. 

11:02:41 replaced all option sheet logic by call to OpenDocOptionSheet. 
ased mapProps In ReleaseParm. 
ot to test for "cancel" in option sheet, 
ed in ComonConversionlmp 1 to handle string substitutions. 

eased width of warning text. Redesigned entire 1ine/subLines concept, replaced with line/pieces, 
ing for buffer. 

12:43:03 named logFile according to document name, 
emented mapping, 
quitting on blank lines, 
acters outside [space..3766] not caught. 

aded paragraph recognition procedure, removed leading spaces. 

6-Apr--87 15:26:20 creation of Convertparms moved here from K4WindowImpl . 

d out saving of logFile; had problem with holding same handle in two processes, 
ced interline in warning window. 

13-’Apr-87 14:41:18 checked for empty fist map.from; release bytes of bufferWB. 

ased resources when cancelling document creation, 
d pre/post/1IneHelght. 

20-Apr-87 13:53:25 picked up initial font size/style/slant/weight from docProps. 

24-Apr-87 16:47:32 new parameter fonProps, fonts moved out of docProps. 

27- Apr-87 13:44:28 page break choices. 

28- Apr~87 18:22:02 underlining vs italics vs plain choice. 

8-May-87 13:22:14 looks like automatic expansion of bufferW did not work; added code to expand it manually. 
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8- ay-87 13:23:18 when font aspect change occurs after first character, all chars between first and the aspect change are dropped; 
extensive change, including new design of the way to translate the input text according to the mappinq options. 

14-May-87 9:31:20 Insured that titan font is not italics and in [ 10 , 12'|. 

23-Mar-88 15:18:13 mapped tab Into tab (was changed to substitute before); fixed the algorithm assigning a paragraph mark on certain 
lines (it was making a paragraph of the last line of real paragraphs!); made paragraphs of lines less than 5 inches long. 

-Apr-88 14:36:41 when a string of spaces are found inside a line, replace it with a tab if there are more than 5 spaces (rather than 3 
; r? m !!I ed 1 the cr1teria Unelength <. 5 inches for paragraph decision (caused problems on documents with narrow paragraphs). 

3-Aug-88 10:03:47 upgraded to BWS4.3/VP2.0: numerous changes in DocInterchangeOefs and company; added session support because of 
DoclnterchangeDefs.FinishCreation. 
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<< File: K4Fi ledDatalmpl.mesa 27-Apr-87 13:00:46 

deLaBeaujardlere:OSBU North:Xerox (deLaBeaujardlere.PA) 
Copyright (C) 1986 by Xerox Corporation. All rights reserved. 

>> 

D[RECTORY Containee. Environment, K4, NSFile, NSFileStream, 
Prototype, StarWindowShel1, Stream, XString; 

K4FiledDataImpl: PROGRAM 

IMPORTS NSFileStream, Stream, XString 
EXPORTS K4 = 

BEGIN 

OPEN XS: XString; 

<<======*=== PUBLIC PROCEDURES ==========>> 


TypeAndVersion: PUBLIC PROCEDURE 

RETURNS [fileType: NSFile.Type. 

version: Prototype.Version] - 


BEGIN 

RETURN [7389325 
19]; 

ENO; 


randomly-chosen number for file type 
current version of the application 
The file type must be assigned an 
official number at productization. 


LoadF HedData: PUBLIC PROCEDURE [parm: K4.IconParms] 

RETURNS [mismatch: BOOLEAN *■ FALSE] = 

BEGIN 

-- This procedure loads into parm the names and values 
-- recorded in the icon file. Memory allocated here to hold 
the bytes for icon/folder/document names 
-- must be freed by the client. 

z: UNCOUNTED ZONE *• parm.heap; 
map, currentMap: K4.Mapping «- NIL: 
signature: CARDINAL *■ Signature []; 

s tream: Stream.Handle ♦- NSFi 1 eStream.Create [parm. iconFi le , FALSE] 
Stream.SetPosition [stream, 0]; 

BEGIN ENABLE Stream. EndOfStream => {mismatch «- TRUE; 

GOTO Termination}; 

-- we should not run out of stream 

- - 1 . Signature. 

parm, signature <- Stream .GetWord [stream]; 

IF parm.signature # signature THEN (mismatch «- TRUE; 

GOTO Termination}; 

2. General Properties 

parm , genProps <- parm.heap .NEW [K4.GeneralPropertyRecord]; 
parm.genProps . iconName <■ LoadReaderBody [stream, z]; 
parm .genProps . channelSpeed «* VAL[Load£numerated[stream]} ; 
parm.genProps.folderName *■ LoadReaderBody [stream, z]; 
parm.genProps.others <- LoadReaderBody [stream, z]; 

-- 3. Document Properties 

parm.docProps *■ parm .heap .NEW [K4.DocunientPropertyRecord]; 
parm.docProps . folderName <- LoadReaderBody [stream, z]; 
parm .docProps . docName «■ LoadReaderBody [stream, z]; 
parm .docProps , justification *■ LoadBoolean [stream]; 
parm.docProps. 1 IneHeight <- VAL[LoadEnumerated [stream]]; 
parm.docProps .preLeading <* VAL[LoadEnumerated [stream]]; 
parm.docProps.postLeading * VAL[LoadEnumerated [stream]]; 
parm.docProps .underl inlng *■ VAL[LoadEnumerated [stream]]: 
parm.docProps .guessMark *■ LoadReaderBody [stream, zj; 
parm.docProps.dropKeepMark «- VAL[LoadF.numerated [stream]]; 
parm .docProps .pageBreak +■ VAL[LoadEnuroerated [stream]]; 
parm.docProps . others «- LoadReaderBody [stream, z]; 

- 4. String Mapping Properties 

parm .mapProps <- parm .heap . NEW [K4 .MapPropertyRecord <- [ 

header; LoadReaderBody [stream, z], 
number: Stream.GetWord [stream], 
map: NIL, 

tagSize: NIL]]; 

FOR k: CARDINAL IN [1..parm.mapProps.number] DO 
map <- parm.heap .NEW [K4 .Mappi ngRecord <- [ 
next: NIL, 

from: LoadReaderBody [stream, z], 
to: LoadReaderBody [stream, z] ]]; 

IF parm,mapProps.map = NIL 
THEN parm.mapProps .map «■ map 
ELSE currentMap.next *• map; 
currentMap «- map; 

ENDLOOP; 

5. Font Properties 

parm. fonProps <- parm.heap. NEW [K4. FontPropertyRecord]; 
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FOR k: CARDINAL IN [0. .9] DO 

parm.fonProps.fonts[k].font <* VAL[LoadEnumerated [stream]]; 
parm. fonProps . fonts[kj . s ize <- VAL[LoadEnumerated [stream]]; 
parm,fonProps.fonts[k].italics «- LoadBoolean [stream]; 
parm.fonProps .fonts[k] .bold «■ LoadBoolean [stream]; 

ENDLOOP; 

EXITS Termination => {}; 

END; -- of ENABLE 

St ream.Delete [stream]; 

END; -- of LoadFI1edData 


StoreFiledOata: PUBLIC PROCEDURE [parm: K4.IconParms] = 

BEGIN 

-- This procedure writed back into the icon file the values 
recorded in the property sheet. 

map: K4.Mapping «■ parm .mapProps .map ; 

signature: CARDINAL *■ Signature[]; 

stream: Stream.Handle «■ NSFi 1 eStream.Create [parm. iconFile, 

FALSE]; 

NSFi1eStream.SetLength [[stream], 0]; -- truncate old stream 

- I. Signature. 

Stream.PutWord [stream, signature]; 

-- 2. General Properties 

StoreReaderBody [stream, ©parm.genProps.iconName]; 

StoreEnumerated [stream, parm.genProps.channel Speed,ORD]; 
StoreReaderBody' [stream, ©parm.genProps.folderName]; 
StoreReaderBody [stream, ©parm.genProps.othersj: 

-- 3. Document Properties 

StoreReaderBody [stream, ©parm.docProps.folderName]; 

StoreReaderBody [stream, ©parm.docProps.docName]; 

StoreBoolean [stream, parm.docProps.justification]; 
StoreEnumerated [stream, parm.docProps.IineHeight.ORD]; 
StoreEnumerated [stream, parm.docProps.preLeading.ORD]; 
StoreEnumerated [stream, parm.docProps.postLeading.ORD]: 
StoreEnumerated [stream, parm.docProps.underlining.ORD]; 
StoreReaderBody [stream, ©parm.docProps.guessMark]: 
StoreEnumerated [stream, parm.docProps.dropKeepMark.ORD]; 
StoreEnumerated [stream, parm.docProps.pageBreak.ORDJ; 
StoreReaderBody [stream, ©parm.docProps.others]; 

-- 4. Mapping Properties 

StoreReaderBody [stream, ©parm.mapProps.header]; 

Stream.PutWord [stream, parm.mapProps.number]; 

FOR k: CARDINAL IN [1..parm.mapProps.number] 

WHILE map ff NIL DO -- should diagnose if map is NIL 
StoreReaderBody [stream, ©map.from]; 

StoreReaderBody [stream, ©map.to]; 
map *■ map. next; 

ENDLOOP; 

-- 5. Font Properties 

FOR k; CARDINAL IN [0. .9] DO 

StoreEnumerated [stream, parm.fonProps.fonts[k].font.ORD]; 
StoreEnumerated [stream, parm.fonProps.fonts[k].size.ORD]; 
StoreBoolean [stream, parm.fonProps.fonts[k].italics]; 
StoreBoolean [stream, parm.fonProps.fonts[k].bold]; 

ENDLOOP; 

Stream.SendNow [stream]; 

Stream.Delete [stream]; 

END; -- of StoreFiledData 


FroelconProps; PUBLIC PROC [props: K4.General Properties, 
z: UNCOUNTED ZONE] = 

BEGIN 

IF props = NIL THEN RETURN; 

XS.FreeReaderBytes [©props.iconName, z]; 
XS.FreeReaderBytes [©props.folderName, z]; 

XS.FreeReaderBytes [©props.others, z]; 

IF props. tagSIze ff NIL THEN z.FREE [©props. tagSize]; 
z.FREE [©props]; 

END; -- of FreelconPropS 


FreeTextProps: PUBLIC PROC [props; K4.DocumentProperties, 
z: UNCOUNTED ZONE] = 

BEGIN 

IF props ■ NIL THEN RETURN; 

XS.FreeReaderBytes [©props.foIderName, z]; 
XS.FreeReaderBytes [©props.docName, zj; 
XS.FreeReaderBytes [©props.guessMark, z]; 

XS.FreeReaderBytes [©props.others. zj; 

IF props . tagSize ff NIL THEN z.FREE [©props . tagSize] ; 
z.FREE [©props]; 

END; -- of FreeTextProps 
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FreeMapProps: 
BEGIN 


PUBLIC PROC [props: K4.MapProperties, 
z: UNCOUNTED ZONE] = 


map, hold: K4.Mapping; 


IF props = NIL THEN RETURN; 

XS.FreeReaderBytes [©props.header, z]; 

FOR map <- props.map, hold WHILE map ft NIL DO 
hold *• fliap. next; 

XS.FreeReaderBytes [©map.from, z]; 

XS.FreeReaderBytes [©map.to, z]; 
z.FREE [©map]; 

ENDLOOP; 

IF props.tagSIze ft NIL THEN z.FREE [©props.tagSize]; 
z.FREE [©props]; 

END; -- of FreeMapProps 


FreeFontProps: PUBLIC PROC [props: K4.FontProperties, 
z: UNCOUNTED ZONE] = 

BEGIN 

IF props = NIL THEN RETURN; 

IF props . tagSize ft NIL THEN z.FREE [©props . tagSize] ; 
z.FREE [©props]; 

END; -- of FreeFontProps 


<<====s===== PRIV atE PROCEDURES ==*=======» 


LoadBoolean: PROC [stream: Stream.Handle] RETURNS [BOOLEAN] = 
INLINE {RETURN [Stream.GetWord[stream] ft 0]}; 


StoreBoolean: PROC [stream: Stream.Handle. boolean: BOOLEAN] = 
INLINE {Stream.PutWord [stream, boolean.ORD]}; 


LoadEnumerated: PROC [stream: Stream.Handle] 
RETURNS [Environment.Word] = 
INLINE {RETURN [Stream.GetWord[stream]]}; 


StoreEnumerated: PROC [stream: Stream.Handle. 

value: Envi ronment .Word] == 
TNLINE {Stream.PutWord [stream, value]}; 


LoadReaderBody: PROC [stream: Stream.Handle. z: UNCOUNTED ZONE] 
RETURNS [rb: XS.ReaderBody] = 

BEGIN 

length: CARDINAL *■ Stream.GetWord [stream]; 

wb: XS.Wrl terBody «- XS.NewWrlterBody [length, z]; 

FOR k: CARDINAL IN [0..length) DO 

XS,AppendChar [@wb, Stream.GetWord[streamj]; 

ENDLOOP; 

rb *• XS.CopyToNewReaderBody[XS.ReaderFromWriter[@wb] , z]; 

-- the bytes allocated here must be released by the client 

XS.FreeWriterBytes[©wb]; 

END; 


StoreReaderBody: PROC [stream: Stream.Handle, r: XS,Reader] = 
BEGIN 

length: CARDINAL <- XS.CharacterLength[r] ; 
lambdaB: XS.ReaderBody «- XS.Dereference [r]; 

Stream.PutWord [stream, length]; 

FOR k: CARDINAL IN [0..length) DO 

Stream.PutWord [stream, XS.Lop[@lambdaB]]; 

ENDLOOP; 

END; 


Signature: PROC RETURNS [CARDINAL] = INLINE 

-- calculates some number likely to change whenever a change is 
■ made to K4.IconParmsRecord. This is to try to catch instances 
where the user has a Kurzwell icon not matching the current 
software version. 

{RETURN [ SIZE [K4.DocumentPropertyRecord] + 

3 * SIZE [K4.MapPropertyRecord] + 

5 * SIZE [K4.FontPropertyRecord] + 

7 * SIZE [K4.GeneralPropertyRecord] + 

II * TypeAndVers1on[].version]}; 


END. -- of K4F1ledDatalmpl 

10-Mar-87 9:47:45 created from code moved from K4IconImpl. 

13-Mar~87 10:11:40 added options and modified others. 
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16- Mar -87 

17- Mar-87 

19- Mar-87 

20- Mar-87 
31-Mar-87 
3l*Mar-87 
14-Apr-87 
24-Apr-87 
2 7-Apr-87 
/ 


9:43:36 added signature. 

14:12:24 added character mapping. 

10:55:28 implemented TypeAndVersion. 

10:25:13 version 14: mapProps.number starts at 0 instead of 1. 

12:30:25 version 16: called Reducelist before writing map.number and only if not 
13:21:36 filed data initialization moved to K4IconImp1. 

14:02:42 version 17: paragraph properties. 

16:15:03 version 18: dropped canvas, moved fonts to separate prop sheet. 

13:00:24 version 19: folder name for transmissions, pageBreak choice. 


creating prototype. 
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<< File: K4IconImp1.mesa 27-Apr-87 13:06:14 

deL.aBeaujardiere:0SBU North:Xerox (deLaBeaujardiere .PA) 
Copyright (C) 1986 by Xerox Corporation. All rights reserved. 


DIRECTORY Atom, Containee, 

Display, Environment, 

Heap, K4, 

NSFile, 

Prototype, 

Simp1eTextDisplay, SimpleTextFont, 
StarWindowShel1, 

XChar, XString; 

K4IconImpl: PROGRAM 

IMPORTS Atom, Containee, Display, 

Heap, K4, NSFile, 

Prototype, 

SimpleTextDisplay, SimpleTextFont, 
XString =. 

BEGIN 

OPEN XS: XString; 

<<===== TYPE DEFINITIONS AND CONSTANTS =====» 

IconRecord: TYPE = RECORD [ 

heap: UNCOUNTED ZONE, 

ol dGenericProc : Containee .GenericProc *■ NIL, 

keyOpen: Atom.ATOM, 

keyProps: Atom.ATOM, 

smal 1 Icon : XS.Character XChar.not]; 


<<===== GLOBAL VARIABLES =====>> 
icon: LONG POINTER TO IconRecord *- NIL; 


<<===== PROCEDURES = = = = = » 


InstalIK4Icon : PROCEDURE = 

BEGIN 

heap: UNCOUNTED ZONE «■ Heap .Create[ 1] ; 

rows: CARDINAL = 13; -- 13 rows in small icon picture 

small Picture: PACKED ARRAY[0 . . rows ) OF WORD «- [ 

177770B, 100010B, 125010B, 100010B, 177770B, 100010B, 137750B, 

1101108, 1701708 . 010100B, 010700B, 010600B, 017400B]; 
iconName: XS. ReaderBody «■ XS . FromSTRING ["Kurzweil 4000"L]; 

inipl : Containee. Implementation: 

iconFIleType: NSFile.Type; 
currentVersion: Prototype.Version; 

[ IconFileType, currentVersion] «■ K4 .TypeAndVersionf ]; 
icon «- heap. NEW[IconRecord]; 

Icon.heap *■ heap; 

icon. keyOpen *- Atom .MakeAtom["Open"L]; 
i con . keyProps *■ Atom .MakeAtom["Props"L]; 

IF Prototype.Find [type: IconFIleType, 

version: currentVersion] = NSFile.nul1 Reference THEN 
MakeNewVerslon [©IconName, IconFileType, currentVersion. heap]; 

impl <■ Containee.Getlmplementation [IconFileType]: 

1 con.oldGenericProc «- impl .genericProc; 
i con. sma111con +■ SimpleTextFont .AddCl ientDef inedCharacter[ 

width: 13. 
height: rows, 
bitsPerLine: 16, 
bits: ©smal1 Picture]: 

impl .genericProc «■ GenericProc: 
impl.name <* iconName; 
impl.smal 1 PictureProc <- PalntSmall Icon; 
impl . pictureProc +• PalntBlglcon ; 

[] «■ Containee.Setlmplementatlon [IconFileType, impl]; 

END; -- of InstallK4Icon 


MakeNewVersion: PROC [iconName: XS.Reader, 

iconType: NSFile.Type. 

1 conversion: Prototype.Version , 
z: UNCOUNTED ZONE] = 

BEGIN 

question: LONG STRING «■ L; 

parm; K4.IconParms <- z.NEW[K4. IconParmsRecord] : 

parm .heap «- z ; 
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parm.genProps *■ z.NEW [K4.GeneralPropertyRecord «- [ 
iconName: iconNamet, 

channelSpeed: ninetySix, 

folderName: XS.FromSTRING ["Kurzweil Transmissions"L], 

others: XS.FromSTRING [ 

"Bits per Char: 8, Stop bits: 1, Parity: None. Asynchronous"!.]]]; 
parm.docProps «- z.NEW [K4.DocumentPropertyRecord «• [ 

folderName: XS.FromSTRING ["Kurzweil Documents"L], 

docName: XS.FromSTRING ["Interpreted Document"L], 

justification: TRUE, 

I ineHeight: single , 

preLeading: single, 

postLeading: singleHalf, 

underlining: underline. 

guessMark: XS.FromSTRING [question], 

dropKeepMark: drop, 

pageBreak: drop. 

others: XS.FromSTRING [ 

"End Line: HOD, End Page: HOC, End Column/Para: None, Horizontal: Preserve, Vertical: Preserve Breaks"L]]]; 
parm.mapProps *■ z.NEW [K4.MapPropertyRecord «* [ 

header: XS.FromSTRING ["Character Substitutions"L], 

number: 0, 

map: NIL]]; 

parm.fonProps z.NEW [K4. FontPropertyRecord *- [ 

fonts: [[classic, ten, FALSE, FALSE], 

[classic, ten, FALSE. TRUE ], 

[classic, ten, TRUE, FALSE], 

[classic, eight, FALSE, FALSE], 

[classic, eight, FALSE, TRUE ], 

[classic, eight, TRUE, FALSE], 

[classic, twelve, FALSE, FALSE], 

[classic, twelve, FALSE. TRUE ], 

[classic, twelve, TRUE, FALSE], 

[classic, fourteen, FALSE, FALSE]]]]: 

parm. iconFile «- Prototype .Create [name: iconName, 

type: iconType, 
subtype: 0, 
version: iconVersion, 
isDirectory: FALSE]; 

Prototype.PurgeOIdVersions [type: iconType. 

Subtype: 0, 

current: iconVersion]; 

K4.StoreFiledData [parm]; 
z.FREE [©parm.genProps]; 
z.FREE [©parm,docProps]: 
z.FREE [©parm.mapProps] ; 
z.FREE [@parm.fonProps] ; 

NSFile.Close [parm.iconFile]; 
z.FREE [@parm] ; 

END: -- of MakeNewVersion 


GenericProc: Containee.GenericProc = 

-- defined as PROC [atom: Atom.ATOM, 
data: DataHandle, 
changeProc: ChangeProc *■ NIL, 
changeProcData: LONG POINTER <- NIL, 

RETURNS [LONG UNSPECIFIED] 

BEGIN 

Shell: LONG POINTER; 

shell «■ SELECT atom FROM 

icon.keyOpen => K4.OpenWindow [data, changeProc, 

changeProcData, 
icon.smal1 Icon], 

icon.keyProps => K4.OpenPSheet [data, changeProc, 

changeProcData], 

ENDCASE => icon.oldGenericProc [atom, data, changeProc, 

changeProcData]; 

RETURN [shell]; 

END; -- of GenericProc 


Err: PROCEDURE[message: LONG STRING] = BEGIN 

msgRB: XString.ReaderBody «- XStr1ng.FromSTRING[message]; 
Contalnee.Error [©msgRB]; 

END; -- of Err 


PaintSmallIcon: Containee.SmallPictureProc = [RETURN[1con.smal1 Icon]}; 


PaintBiglcon: Containee.PictureProc = BEGIN 
widtftlnPixels; CARDINAL = 65; 
widthlnWords: CARDINAL = 5; 
heightlnPixels: CARDINAL = 60; 

IF new=garbage THEN RETURN 
ELSE BEGIN 

HleName: XS.ReaderBody; 
cacheTlcket: Containee.Ticket; 

mask: ARRAY[0..widthInWords*heightInPixels) OF WORD <- [. 
037777B, 177777B, 177777B, 177776B, 0000008, 

077777B, 177777B, 177777B, 177777B, OOOOOOB, 

177777B, 177777B, 177777B, 177777B, 10000QB. 

177777B, 1777778, 177777B, 177777B. 100000B, 
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177777B, l77777B, 177777B, 1777778, 1000008, 

177777B . 1777778, 177777B, 1777778, 1000008, 

177777B, 177777B. 177777B, 177777B, 1000008, 

177777B. 177777B, 177777B, 1777778, 100000B, 

177777B, 177777B, 177777B, 177777B, 100000B, 

177777B, 177777B, 177777B, 177777B, 100000B, 

177777B, 177777B, L77777B. 177777B, 1000008, 

1 77777B, 177777B, 177777B, 177777B, 100000B, 

17 7 7 7 78, 1777776, 177777B. 1777778, 100000B, 

177777B, 177777B, 177777B, 177777B, 100000B, 

1 77777B, 177777B , 177777B, 1777778, 100000B, 

17777/B, 177777B, 177777B, 177777B, 1000008, 

177777B, 177777B, 1777778', 177777B, 100000B, 

177777B. 177777B, 177777B, 177777B, 100000B, 

17 7 7 7 7 B , 177777B, 177777B. 177777B, IOOOOOB, 

177777B, 1/7777B, 177777B, 177777B, 100000B, 

1777778, 177777B, 177777B, 1777778, 100000B. 

177777B, 177777B, 177777B, 177777B, 100000B, 

177777B, 177777B, 177777B, 177777B, 100000B, 

177777B, 177777B, 177777B, 177777B, 100000B, 

177777B, 177777B, 177777B, 177777B, 100000B, 

177777B, 1777778, 177777B, 1777778, 100000B, 

177777B, 1 77777B, 177777B, 177777B, 100000B, 

17777 7B, 177777B, 177777B, 177777B, 100000B, 

177777B, 177777B, 177777B, 177777B, 100000B, 

17 7777B, 177777B, 177777B, 177777B, 1000008. 

17 7 7 7 7 B , 177777B , 177777B, 177777B, I00000B, 

177777B. 177777B, 177777B, 177777B. IOOOOOB, 

177777B, 177777B, 177777B, 177777B, IOOOOOB, 

1 7 7 7 7 78, 177777B, 1 777 7 /B, 177777B, IOOOOOB, 

077777B, 177777B, 1 77777B, 177777B, OOOOOOB, 

037777B, 177777B. 177777B, 177776B, OOOOOOB, 

000077B, 177777B, 177777B, 177000B, OOOOOOB, 

000077B, 177777B, 177777B. 177000B, OOOOOOB. 

000077B, 1 77777B, 177777B, 177000B, OOOOOOB, 

000077B, 177777B, 1777778. 177000B, OOOOOOB, 

0000778, 177777B. 177777B, 177000B, OOOOOOB, 

000077B, 177 777B, 1 /77 7 7B, L77000B, OOOOOOB, 

0000778, 177777B. 177777B, 177000B, OOOOOOB. 

000077B, 177777B, 177777B, 177000B. OOOOOOB, 

000077B, 177777B, 177777B, 177000B. OOOOOOB, 

000077B, 177777B, 177777B, 177000B, OOOOOOB, 

000077B, 177777B, 177777B, 177000B, OOOOOOB, 

000077B, 177777B, 177777B, 177000B, OOOOOOB, 

000077B, 177777B, 17-7777B, 177000B. OOOOOOB, 

000077B, 177777B, 177777B, 177000B, OOOOOOB, 

000077B, 1777778, 1777778, 177000B, OOOOOOB, 

0000778, 177777B, 177777B, 177000B, 071145B. 

000077B, 177777B, 177777B, 176000B, 000022B, 

000077B, 177777B. 177777B, 174000B, 007144B, 

000077B, 177777B, 177777B, 170000B, 000022B, 

000077B, 177777B, 177777B, 160000B, 002312B, 

000077B, 1 77777B , 177777B, 140000B, 000005B, 

0 0 0 0 7 7 B , 177777B, 177777B, IOOOOOB, 000005B, 

000077B, 177777B, 177777B, OOOOOOB, 000025B, 

000077B, 177777B, 177776B. OOOOOOB, 064556B]; 

IF new=reference OR new=referenceHigh>1ghted THEN new *■ normal; 

box.place.x box,place.x + 2; 

box. dims, w <- wldthlnPixel§; 

box.place.y <- box.place.y + 8; 

box.dims.h «- he IghtlnPI xel s; 

Display,B1tmap[ 
window: window, 
box: box, 

address: [word: ©mask, bit: 0], 

bitmapBitWidth: widthInWords*Env1ronment.bitsPerWord, 
flags: SELECT new FROM 

highlighted, referenceHighlighted => [ --for inverting picture 
disjoint: TRUE, 
srcFunc: null, 
dstFunc: or], 

ENDCASE => [ 
disjoint: TRUE, 
srcFunc: complement, 
dstFunc: and]]; 

XF newtfghost THEN BEGIN 

picture: ARRAY[0 . .widthInWords*heightInPixels) OF WORD «■ [ 

037777B, 177777B. 177777B. 177776B, OOOOOOB, 

077777B, 177777B, 1777778, 177777B, OOOOOOB, 

160000B, OOOOOOB, OOOOOOB, 000003B. IOOOOOB, 

140000B, OOOOOOB, OOOOOOB, 000001B, IOOOOOB. 

140000B, OOOOOOB, OOOOOOB, 0000018, IOOOOOB, 

140000B, OOOOOOB, OOOOOOB, 000001B, IOOOOOB, 

140000B, OOOOOOB, OOOOOOB. 000001B, IOOOOOB, 

140000B, OOOOOOB, OOOOOOB, 000001B, IOOOOOB, 

140000B, 0000008, OOOOOOB, 000001B. IOOOOOB, 

140000B, OOOOOOB, OOOOOOB, 000001B, IOOOOOB, 

140000B, OOOOOOB, OOOOOOB, 00000IB. IOOOOOB, 

140000B, OOOOOOB, OOOOOOB, 000001B, IOOOOOB. 

1400008, OOOOOOB, OOOOOOB, 000001B, IOOOOOB, 

140000B, OOOOOOB, OOOOOOB, 000001B, IOOOOOB, 

140000B, OOOOOOB. OOOOOOB, 00000IB, IOOOOOB, 

140000B, OOOOOOB, OOOOOOB, 000001B, IOOOOOB, 

140000B, OOOOOOB, OOOOOOB, 000001B, IOOOOOB, 
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1400008, 0000006, OOOOOOB, 000001B, 100000B, 

140000B, OOOOOOB, 0000008, 000001B, 1000006, 

140000B, OOOOOOB, OOOOOOB, 000001B, 100000B, 

140000B. OOOOOOB, OOOOOOB, 000001B, lOOOOOB, 

177777B, 1777778, 1777778, 177777B, lOOOOOB, 

140000B, OOOOOOB, OOOOOOB, 000001B, lOOOOOB, 

140000B, OOOOOOB, OOOOOOB, OOOOOIB, lOOOOOB, 

140000B, OOOOOOB, OOOOOOB, OOOOOIB, lOOOOOB. 

140000B, OOOOOOB, OOOOOOB, OOOOOIB, lOOOOOB, 

140000B, OOOOOOB, OOOOOOB. OOOOOIB, lOOOOOB, 

141777B, 177777B, 177777B, 17/741B, lOOOOOB, 

141760B, 0000008, OOOOOOB, 003741B, lOOOOOB, 

I40020B, OOOOOOB, OOOOOOB, 0020018, lOOOOOB, 

140020B, 052620B, 052525B, 002001B, lOOOOOB, 

140020B, 0252528, 125252B, 002001B, lOOOOOB, 

140020B, OOOOOOB, OOOOOOB, 002001B, lOOOOOB, 

160020B, OOOOOOB, OOOOOOB, 002003B, lOOOOOB, 

077760B, 052525B, 062525B, 003777B, OOOOOOB, 

0377608, 025252B, 125252B, 003776B, OOOOOOB. 

000060B, OOOOOOB, OOOOOOB, 0030000'. OOOOOOB, 

ooooeoe, oooooob, oooooob, 003000 B, oooooob, 

OOOOOOB, 052625B, 052525B, 003000B, OOOOOOB, 

000060B, 0252528, 125252B, 003000B, OOOOOOB, 

OOOOOOB, OOOOOOB, OOOOOOB, 003000B, OOOOOOB, 

OOOOOOB, OOOOOOB, OOOOOOB, 003000B, OOOOOOB, 

OOOOOOB, 052525B , 052525B, 003000B, OOOOOOB, 

000060(1, 0202520. 125252B , 003000B , OOOOOOB, 

OOOOOOB, OOOOOOB, OOOOOOB, OOOOOOB, OOOOOOB, 

OOOOOOB, OOOOOOB, OOOOOOB, 003000B, OOOOOOB, 

000060B, 052G25B, 052526B, 003000B, OOOOOOB, 

000060B, 025252B, 125252B, 003000B, OOOOOOB, 

000060B, OOOOOOB, OOOOOOB, 003000B. OOOOOOB, 

0000608, OOOOOOB, OOOOOOB, 003000B, OOOOOOB, 

000060B, OOOOOOB, OOOOOOB, 003000B, OOOOOOB, 

OOOOOOB, 0000008, 000007B. 177000B, OOOOOOB, 

OOOOOOB, OOOOOOB, 000004B, 016000B. OOOOOOB, 

OOOOOOB, OOOOOOB, 000004B, 034000B, OOOOOOB 

OOOOOOB, OOOOOOB, 0000048, 070000B, OOOOOOB, 

OOOOOOB. OOOOOOB, 000004B, lOOOOOB, OOOOOOB, 

OOOOOOB, OOOOOOB, OOOOOOB, 140000B, OOOOOOB. 

OOOOOOB, OOOOOOB, 000007B, lOOOOOB, OOOOOOB. 

000077B, 177777B, 177777B, OOOOOOB, OOOOOOB, 

000077B, 177777B, 177776B, OOOOOOB, OOOOOOB]; 

01 splay.B1tmap[ 
window: window, 
box; box, 

address; [word: Spicture, bit: 0], 

b i tmapB 1 tWi dth : w i dthInWordS' 1 Envi ronmon t. b i tsPerWo rd , 
flags: SELECT new FROM 

highlighted, referenceHighlighted *> [ 
disjoint: TRUE, 
srcFunc: complement, 
dstFunc: and], 

ENDCASE => [ 
disjoint: TRUE, 
srcFunc: nul1 , 
dstFunc: or]]: 

END; --of drawing In the picture per se (not a ghost) 

[filename, cacheTicket] <- Contai nee ,GetCachedName[data]; 
[] e SimpleTextDisplay.Str1ngIntoWindow[ 
string: SfileName, 
window: window-, 

place: [x: box.place.x ♦ 3, y: box.place,y - 3], 

linewidth: widthlnPixels - 6, 

maxNumberOfLines: 1, 

wordBreak: FALSE, 

flags: SELECT new FROM 

highlighted, referenceHighlighted => [ 
disjoint: TRUE, 
srcFunc: complement, 
dstFunc: and], 

ENDCASE -> Display.paintFlags]: 

Cootainee.ReturnTicket[cacheTieket]; 

END; --of drawing: i.e., not garbage 
END; -- of PaintBiglcon 




MAIN LINE CODE * = = = = -•»«,» 


Install l<4Icon[]; 

END. -- of K4IconImpl 

14-Jan-87 15:03:40 created from DestTextlconlmpl. 

6-Feb-87 15:35:08 changed initial preset of pSheet. 

10-Mar-87 9:50:14 removed Courier usage, moved Load/StoreFiledData to K4Fi1ed0ataImpl. 

19-Mar-87 11:05:26 used TypeAndVersion to get fileType/verslon, 

3i-Mar-87 13:50:53 moved initialization of icon main data store here from K4Fi1edOatalmpl. 
14-Apr-87 13:53:19 added paragraph properties. 

24-Apr-J}7 16:22:04 dropped canvas and ArtScan. moved fonts to separate prop sheet. 
27-Apr-87 13:05:58 foldername for transmissions, page break. 

/ 
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<< File: K4PSheetImpl.mesa 28-Apr-87 16:59:05 

deLaB(»aujardiere:OSBU North:Xerox (deLaBeaujardiere.PA) 
Copyright (C) 1986 by Xerox Corporation. All rights reserved. 

>> 

DIRECTORY 

Attention, Contalnee, 

Environment, FormWindow, Heap, 

K4, 

NSFile, NSString, 

PropertySheet, 

S i nip 1 eTex tD i splay, 

StarWindowShel1, Window, XString; 

K4PSheetImpl: PROGRAM 

IMPORTS Attention, 

FormWindow, Heap, K4, NSFile, NSString. 

PropertySheet, 

SimpleTextDisplay, XString 

EXPORTS K4 = 

BEGIN 

OPEN FW: FormWindow, 

K4, 

XS: XString; 


<<========ss PUBLIC PROCEDURES ^=========>> 


OpenPSJieet: PUBLIC PROCEDURE [iconData: Con ta i nee .DataHandle , 

changeProc: Containee,ChangeProc, 
changeProcData: LONG POINTER] 

RETURNS [StarWindowShel1.Handle] = 

BEGIN 

zone: UNCOUNTED ZONE «- Heap.Create [1]: 

--deleted by OoPropsCommands 
pSheetPlace: Window,Place «• PropertySheet. nul IPlace : 
pSheetSize: Window.Dims *• [0, 0]; 

pSheetName: XS.ReaderBody «- XS.FromSTRING [ 

"Kurzwell 4000 Properties'’L] ; 
versionMismatch: BOOLEAN: 

iconParms: K4.IconParms *• zone.NEW [K4. IconParmsRecord <- [ 

heap: zone, 
iconData: iconData, 
changeProc: changeProc. 
changeProcData: changeProcData, 
iconFile: NSF1le.OpenByReference 

[iconData.referenceJ ]]; 

-- freed by TakeDownPSheet 

versionMismatch «■ K4. LoadFi ledData [iconParms]: 

-- unloaded.by TakeDownPSheet 

IF versionMismatch THEN 

BEGIN 

Msg ["Obsolete icon does not work with new software"L]: 

NSFile.Close [IconParms.iconFile]; 

zone,FREE [©IconParms]; 

Heap.Delete [zone]: 

RETURN [StarWindowShel1.nullHandle]; 

END; 

Create the Property Sheet, 
iconParms .propSheet «• PropertySheet .CreateLinked [ 

1InkWindowItems: MakeLinkProps, 

1inkWindowIternsLayout: LayLinkltem, 

formWindowItems: MakeTextProps, -- first shown 

formWindowItemsLayout: LayTextProps, -- is text sheet 

menuItemProc: SetTextProps, 

menultems: [done: TRUE, cancel: TRUE], 

title: ©pSheetName, 

size: pSheetSize, 

placetoDisplay: pSheetPlace, 

afterTakenDownProc: TakeDownPSheet, 

clientData: iconParms]; 

RETURN [iconParms.propSheet]; 

END: -- of OpenPSheet 


OpenDocOptionSheet: PUBLIC PROC [ 

convertParm: K4.ConvertParms, 
takeDown: PropertySheet.MenuItemProc] = 

BEGIN 

pSheetName: XS.ReaderBody *■ XS.FromSTRING ["Document Options"L]; 
pSize: Window.Dims «- [500, 400]; 
pPlace: Window.Place «- [500, 50]; 

convertParm.optlonSheet <- PropertySheet .CreateLinked [ 
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1inkWindowIterns: MakeLinkOptions, 

1InkWindowItemsLayout: LayLinkltem, 

formWindowItems: MakeTextOptions, -- first shown 

formWindowItemsLayout: LayTextOptions, -- is text 

menuItemProc: SetJextOptIons, 

menulterns: [start: TRUE, cancel: TRUE], 

title: ©pSheetName, 

Size: pSize, 
placeToDisplay: pPlace, 
afterTakenOownProc: takeOown. 
clIentData: convertParm]; 

END; -- of OpenDocOptionSheet 


<<========== PRIVATE procedures for document subwindow ==========>> 


MakeTextOptions: FW.MakeltemsProc - 
BEGIN 

parm: K4.ConvertParms *■ LOOPHOLE[cl ientData]; 
MakeTextltems [window, parm.docProps . parm.zone]: 
END; of MakeTextOpt ions 


MakeTextProps: FW.MakeltemsProc - 
BEGIN 

iconParm: K4.IconParms «- L00PH0LE[c 1 ientData] ; 
MakeTextltems [window, iconParm.docProps, iconParm.heap]; 
END; -- of MakeTextProps 


MakeTextltems: PROC [window: Window.Handle. 

docProps: K4.DocumentProperties, 
z: UNCOUNTED ZONE] - 

BEGIN . 

label: XS.ReaderBody; 

underl iningChoices : FW. Cho i cel terns «- DESCRIPTOR [uChoices]; 
uChoices: ARRAY [0..3) OF FW.ChoiceItem - [ ' 

[string [choiceNumber: Underlining.underline.ORD. 

string: XStr i.ng. FromSTR ING ["Underl i ne"L] ] ], 
[string [choiceNumber: Under Iining.itaIics.ORD. 

String: XString.FromSTRING["ItaIics"L]]]. 

[string [choiceNumber: Underlining.pI ain.ORD, 

String: XString.FromSTRING["PIain"L]]] ]; 

lineChoices: FW.Choiceltems * DESCRIPTOR [ICholces]; 

IChoices: ARRAY [0..4) OF FW. Cho i cel tem «- [ 

[string [choiceNumber: LineSpacing.single.ORD, 

string: XString.FromSTRING["Single"L]]]. 

[String .[choiceNumber: LIneSpacing.singleHalf.ORD. 

String: XString.FromSTRING["1 1/2"L]]]. 

[string [choiceNumber: LineSpacing.double.ORD, 

String: XString.FromSTRING["Double"L]]], 

[string [choiceNumber: LineSpacing.triple.ORD. 

string: XString.FromSTRING["Triple"L]]] ]; 

guessChoices: FW.Choiceltems «• DESCRIPTOR [gChoices]: 
gChoices : ARRAY [0..2) OF FW.Cholceltem [ 

[string [choiceNumber: DropKeep.drop.ORD, 

string: XString.FromSTRING["Drop"L]]]. 

[string [choiceNumber: DropKeep.keep.ORD, 

String: XString.FromSTRING["Keep"L]]] ]; 

pageBreakChoices; FW.Choiceltems <- DESCRIPTOR [pChoices]: 
pCholces: ARRAY [0..3) OF FW.Choice Item + [ 

[string [choiceNumber: Underlining.underline.ORD. 

String: XString.FromSTRING["None"L]]], 

[string [choiceNumber: Underlining.italics.ORD, 

string: XString.FromSTRING["Every Page"L]]], 
[string [choiceNumber: Underlining.plain.ORD, 

string: XString.FromSTRING["Unf11 led Pages”L]]] ]; 

IF docProps.tagSize = NIL THEN 
docProps . tagSize «■ z . N£W[TextTagSizes]; 

-- released by FreeTextProps 

docProps. tagSize[folderName] «- Measure [@label . "Document Folder Name"L]; 
FW.MakeTextltem [window: window, myKey: K4.Textltems.folderName.ORD, 
tag: ©label , 

initString: ©docProps.folderName. 
width: 200]; 

docProps. tagSize[docName] ♦- Measure [©label, "Document Name"L]; 
FW.MakeTextltem [window: window, myKey: K4.TextItems.docName.ORD, 
tag: ©label , 

initString: ©docProps.docName, 
width: 200]; 

docProps .tagS1ze[justlfication] <- Measure [©label. 

"Paragraph Right Edge"L]: 

Fw.MakeBooleanItem[window: window, 
myKey: K4.TextItems.justification.ORD, tag: ©label, 
label: [string [XString.FromSTRING["Just1fy"L]]], 
initBoolean: docProps.justification]; 
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docProps . tagSize[l ineHelght] <- Measure [©label, 

"Paragraph Line Heighf’L]; 

FW.MakeChoiceltemfwlndow: window, 
myKey: K4.Textltems.1ineHeight.ORD, tag: ©label, 
values: lineChoices, 
inltChoice: VAL[docProps.1ineHeight]]; 

docProps. tagSize[preLeading] *• Measure [©label, 

"Lines before Paragraph"L] ; 

FW.MakeCho1celtem[window: window, 
myKey: K4.Textltems.preLeading.ORD, tag: ©label, 
values: lineChoices, 
initChoice: VAL[docProps.preLeading]]; 

docProps.tagSize[postLeading] «- Measure [©label, 

"Lines after Paragraph"L]; 

FW.MakeChoiceltem[window: window, 
myKey: K4.Textltems.postLeading.ORD, tag: ©label, 
values: lineChoices, 
initChoice: VA'L[docProps .postLeading]] ; 

docProps . tagS1ze[underl ining] «- Measure [©label. "Underl ining"L]; 

FW.MakeChoiceItem[window: window. 
myKey: K4,Textltems.underlining.ORD, tag: ©label, 
values: underliningChoices. 
in i tCho ice: VAL[docProps.underlining]]: 

docProps . tagSize[guessMark] <- Measure [©label, 

"Questionable Character"L]; 

FW.MakeTextltem [window: window, myKey: K4.Textltems.guessMark.ORD, 
tag: ©label, 

initString: ©docProps.guessMark, 
width: 40]; 

FW.MakeChoiceltem[window: window, 
myKey: K4.Textltems.dropKeepMark.ORD, tag: NIL. 
values: guessChoices, 
initChoice: VAL[docProps.dropKeepMark]]; 

docProps, tagSize[pageBreak] «- Measure [©label, "Page Break"L]: 

FW.MakeChoiceltem[window: window. 
myKey: K4.Textltems.pageBreak.ORD, tag: ©label, 
values: pageBreakChoices, 
initChoice: VAL[docProps.pageBreak]]; 

docProps . tagSize[other$] «- Measure [©label, 

"Required Tailor Choices"L]; 

FW.MakeTextltem [window: window, myKey: K4.Textlterns.others.ORD, 
tag: ©label, 

initString: ©docProps.others, 

width: 300, boxed: FALSE, readonly: TRUE]; 

END; -- of MakeTextltems 


LayTextOptions: FW.LayoutProc = 

BEGIN 

parm: K4 .ConvertParms *• L00PH0LE[cl ientData] ; 
LayTextltems [window, parm,docProps, parm.zone]; 
END; -- of LayTextOptlons 


LayTextProps: FW.LayoutProc - 
BEGIN 

iconParm: K4.IconParms. «■ L00PH0LE[c 1 ientData] ; 
LayTextltems [window, iconParm.docProps, iconParm.heap]; 
END; --of LayTextProps 


LayTextltems: PROC [window: Window.Handle, 

docProps: K4.DocumentProperties. 
z: UNCOUNTED ZONE] = 

BEGIN 

margin: CARDINAL = 5; 
maxTag: CARDINAL <- 0; 
line: FW.Llne; 

ts: LONG POINTER TO TextTagSIzes *■ docProps . tagSize: -- accelerator 

LaySi-ngleltem: PROC [itemKey: K4.Textltems, 

tagSize, Interline: CARDINAL] = 

BEGIN 

IF interline > 0 THEN 

line «■ FW,AppendLine[window: window. 

spaceAboveLine: interline]: 
FW.AppendItem[window: window, line: line, 
item: itemKey.ORD, 
preMargin: IF interline = 0 THEN 8 

ELSE Prespace[tagSize, maxTag. margin]]; 
END; -- of LaySingleltem 

FOR k: Textltems IN Textltems DO 
maxTag «- MAX [maxTag, ts[k]]-; 

ENDLOOP; 

LaySingIeltem[foiderName, ts[folderName], 6]; 

LaySingleItem[docName, ts[docName], 6]; 

LaySingleItem[justifIcation, ts[justification], $]; 

LayS1ngleItem[lineHeight, ts[lIneHelght], 6]; 
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LaySIngleltem[preleading, ts[preLeading], 6]; 
LaySing)eItem[postLeading, tsfpostLeadlng], 6]; 
LaySing1eltem[underl ining, ts[underlining], 6]; 
LaySingleItem[guessMark, ts[guessMark], 6]; 
L.aySingleItem[dropKeepMark, ts[dropKeepMark] , 0]: 
L.aySingleItem[pageBreak, ts[pageBreak] , 6]; 
LaySingleItem[others, ts[others], 12]: 

FW,Repaint [window]; 

END; -- of LayTextltems 


SetTextOptionsPropertySheet.MenuItemProc = 

BEGIN 

parm: K4.ConvertParms <- LOOPHOLE[clientData]: 

RETURN [SetTextltems [formWIndow, parm.docProps, parm.zone]]; 
END; -- of SetTextOptions 


SetTextProps: PropertySheet.MenuItemProc = 

BEGIN 

iconParm: K4. IconParms «■ LOOPHOLE[clientData]; 

RETURN [SetTextltems [formWindow, iconParm.docProps, iconParm.heap]] 
END; -- of SetTextProps 


SetTextltems: PROC [window: Window.Handle. 

docProps: K4.DocumentProperties, 
z: UNCOUNTED ZONE] 

RETURNS [BOOLEAN] = 

BEGIN 

Boolean: PROCEDURE [item: Textltems] RETURNS [BOOLEAN] - INLINE 
(RETURN [FW.GetBooleanltemValue [window. item.ORO]]}; 

Choice: PROCEDURE [item: Textltems] RETURNS [CARDINAL] = INLINE 
(RETURN [FW.GetChoiceltemValue [window. item.ORD] ]}; 

IF NOT.FW.HasAnyBeenChanged [window] THEN RETURN [TRUE]: 

IF FW.HasBeenChanged [window, Textlterns.foIderName.OROj THEN 
BEGIN 

docProps.folderName «- UpdateBody [window. 

Textltems.folderName.ORD, 
©docProps.folderName. z]; 

IF XS.Empty [©docProps.foIderName] THEN 
BEGIN 

Msg ["Folder name cannot be empty"L]; 

RETURN [FALSE]; 

END; 

END; 


IF FW.HasBeenChanged [window. Textltems.docName.ORD] THEN 
BEGIN 

docProps .docName *■ UpdateBody [ 

window, Textltems.docName.ORD. 
©docProps.docName, z]; 

IF XS.Empty [©docProps.docNameJ THEN 
BEGIN 

Msg ["Document name cannot be empty"L]; 

RETURN [FALSE]; 

END: 

END; 


docProps.justification «- 
docProps . 1 ineHeight *- 

docProps .preLeading «• 

docProps .postLeading «• 

docProps .underl ining «- 

docProps .dropKeepMark <- 

docProps. pageBreak «- 


Boolean [K4.Textltems.justification]; 

VAL [Choice [K4.Textltems.1ineHeight]]; 
VAL [Choice [K4.Textltems.preLeading]]; 
VAL [Choice [K4.Textltems.postLeading]]; 
VAL [Choice [K4.Textltems.underlining]]; 
VAL [Choice [K4.Textlterns.dropKeepMark]]; 
VAL [Choice [K4.Textltems.pageBreak]]; 


IF FW.HasBeenChanged [window, Textltems.guessMark.ORD] THEN 
docProps.guessMark «• UpdateBody [ 

window, Textltems.guessMark.ORO, 
©docProps.guessMark, z]; 


RETURN [TRUE]; 

END; -- of SetTextltems 


«====**==== PRIVATE PROCEDURES FOR MAPPING SUBWINDOW 


<< Road map to their usage: 
MakeMapOptions 

MakeMapProps 

LayMapOptions 

LayMapProps 

AddNextMapOptions 

AddNextMapProps 


=> MakeMapItems 
=> MakeNextMapIterns 
=> MakeMapItems 
=> MakeNextMapItems 
=> LayMapItems 
=> LayMapItems 
=> MakeNextMapItems 
= > LayNextMapItems 
=> MakeNextMapItems 
=> LayNextMapItems 


>> 
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MakeMapOptlons: FW.MakeltemsProc = 

BEGIN 

parm: K4 .ConvertParms «• LOOPHOLE[clientData]; 

MakeMapIterns [window, AddNextMapOptions, parm.mapProps, parm. zone]: 

-- If no mapping option exists yet,- must display an empty pair 
IF parm,mapProps.number = 0 THEN 

MakeNextMapItems [window, AddNextMapOptions, 
parm.mapProps, parm.zone]; 

END: -- of MakeMapOptions 


MakeMapProps: FW.MakeltemsProc = 

BEGIN 

ip: K4.IconParms «■ LOOPHOLE[cl ientData]; 

MakeMapItems [window, AddNextMapProps, ip.mapProps, ip.heap]; 
IF ip.mapProps.number = 0 THEN 

MakeNextMapIterns [window, AddNextMapProps, 
ip.mapProps. ip.heap]; 

END; -- of MakeMapProps 


MakeMapIterns: PROC [window: Window.Handle, 

nextOut: FW.NextOutOfProc. 

•mapProps; K4.MapProperties. 
z: UNCOUNTED ZONE] - 

BEGIN 

-- Create window items for the header and the 
- existing from/to pairs, 
label: XS.ReaderBody; 

map; K4.Mapping *■ mapProps. map; -- may be NIL if no items yet. 

IF mapProps.tagSize = NIL THEN 

mapProps . tagSize «- z .NEW[MapTagSizes]; -- released by FreeMapProps 

mapProps . tagSi ze[header] «- 0; 

FW.MakeTextItem[window: window, 
myKey: 0, 
tag: NIL, 

initString; ©mapProps.header, 

width: 300, boxed: FALSE, readonly: TRUE]; 

mapProps . tagSize[f rom] *- Measure[@label , " "L]; 

mapProps . tagSize[to] *■ 0 ; 

FOR k: CARDINAL IN [1..mapProps.number] DO 

FW.MakeTextltemfwindow: window, tag: ©label, width: 50, 
myKey: 2*k - L, initString: ©map.from]; 
FW.MakeTextItem[window: window, tag: NIL, width: 50, 
myKey: 2*k, initString: ©map.to, 
nextOutOfProc: nextOut]; 

map <- map. next: 

ENDLOOP; 

END; -- of MakeMapItems 


MakeNextMapItems: PROC [window: Window.Handle, 

nextOut: FW.NextOutOfProc. 
mapProps: K4.MapProperties, 
z: UNCOUNTED ZONE] = 

BEGIN 

Add an entry in mapProps. and create 
- the corresponding pair of window items. 

empty: XS.ReaderBody «- XS.FromSTRING [""L]; 
map: K4 .Mapping *■ z.NEW [K4.MappingRecord «• [ 

from: XS.CopyToNewReaderBody [©empty, z], 
to: XS.CopyToNewReaderBody [©empty, z], 

next: NIL]]; 

IF mapProps.map = NIL THEN mapProps.map *■ map 
ELSE 
BEGIN 

FOR last: K4.Mapping <- mapProps .map , last.next DO 
IF last.next = NIL THEN (last.next «• map; EXIT}; 

ENDLOOP; 

END; 

mapProps . number <- mapProps . number + 1; -- update number of pairs 

FW..MakeTextItem[w1ndow: window, tag: NIL, width: 50. 

myKey: 2*mapProps.number - 1, 
initString: ©map.from]; 

FW.MakeTextItem[window: window, tag: NIL. width: 50, 
myKey: 2*mapProps.number, 

InitString: ©map.to, 
nextOutOfProc: nextOut]; 

END; -- of MakeNextMapItems 


LayMapOptions: FW.LayoutProc = 

BEGIN 

parm: K4 .ConvertParms «• LOOPHOLE[cl ient'^fta]; 
LayMapItems [window, parm .mapProps, pafCzone]; 
END; -- of LayMapOptions 
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LayMapProps: FW.LayoutProc - 
BEGIN 

iconParm: K4.IconParms *■ LOOPHOLE[cl ientData] ; 
LayMapItems [window, iconParm.mapProps, iconParm heap]; 
END; --- of LayMapProps 


LayMapItems: PROC [window: Window.Handle, 

mapProps: K4.MapProperties, 
z: UNCOUNTED ZONE] = 

BEGIN 

margin: CARDINAL = 5; 
spaceBetweenLines: CARDINAL = 3; 
preMargin, maxTag: CARDINAL *■ 0: 
line: FW.Line: 

FOR k: MapIterns IN MapIterns DO 
maxTag «• MAX [maxTag, mapProps.tagSize[k]]; 

ENDLOOP; 

line «- FW.AppendLine[window: window, 

spaceAboveLine: 2 * spaceBetweenLines]; 

FW.AppendItem[window: window, line: line, 
item: K4.MapIterns.header.ORD, 

preMargin: Prespace[mapProps.tagS ize[K4.Map I terns.header]. 
maxTag, margin]]; 

preMargin <- Pre$pace[mapProps . tagSize[K4.Mapltems . f rom], 

maxTag. margin]; 

FOR k: CARDINAL IN [I..mapProps.number] DO 
line *■ FW. AppendL i ne[w i ndow: window, 

spaceAboveLine: 2 * SpaceBetweenLines]; 
FW.AppendItem[window: window, line: line, 

item: 2*k - l. preMargin: preMargin]; 

FW.Appendltem[w1ndow: window, line: line. 

item: 2*k. preMargin: 8]; 

ENDLOOP; 

FW.Repaint [window]; 

END; -- of LayMapItems 


LayNextMapItems: PROC [window: Window.Handle, 

mapProps: K4.MapPropertiesJ = 

BEGIN 

margin: CARDINAL = 5; 
spaceBetweenLines; CARDINAL = 3; 
preMargin: CARDINAL; 
maxTag: CARDINAL <- 0; 
line: FW.LIne; 

lastTo: FW.ItemKey *■ 2*mapProp$.number; 

FOR k: Mapltems IN Mapltems DO 
maxTag *• MAX [maxTag, mapProps . tagSize[k]] ; 

ENDLOOP; 

line «• FW.AppendLine[window: window, 

spaceAboveLine: 2 * spaceBetweenLines]:. 
preMargin <- Prespace[mapProps.tagSize[K4.MapItems.from], 
maxTag, margin]; 

FW.AppendItem[window: window, line: line, 

item: lastTo 1, preMargin: preMargin]; 

FW.AppendItem[window: window, line: line, 
item: lastTo, preMargin: 8]; 

FW.Repaint [window]; 

END; -- of LayNextMapItems 


AddNextMapOptions: FW.NextOutOfProc = 

BEGIN 

““ If NEXTing out of the last field, make and lay a new pair 

parm: K4 .ConvertParms «- LOOPHOLE[FW .GetCl ientData [window]]; 

IF item = FW.NumberOfItems[window] THEN 
BEGIN 

MakeNextMapIterns [window, AddNextMapOptions, 
parm.mapProps, parm.zone]; 

LayNextMapItems [window, parm.mapProps]: 

END; 

END: -- of AddNextMapOptions 

AddNextMapProps: FW.NextOutOfProc = 

BEGIN 

-- If NEXTing out of the last field, make and lay a new pair 

iconParm,* K4.IconParms *■ LOOPHOLE[FW,GetCl ientData [window]]; 

IF item = FW.NumberOfItams[window] THEN 
BEGIN 

MakeNextMapItems [window, AddNextMapProps, 

iconParm.mapProps, iconParm.heap]: 
LayNextMapItems [window, iconParm.mapProps]; 

END; 
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END; of AddNoxtMapProps 


SetMapOptlons: PropertySheet.MenuItemProc = 

BEGIN 

parm: K4.ConvertParms <- LOOPHOLE[clientData]; 

RETURN [SetMapItems [formWindow, parm.mapProps, parm.zone]]; 
END; -- of SetMapOptlons 


SetMapProps: PropertySheet.MenuItemProc = 

BEGIN 

IconParm: K4.IconParms «• LOOPHOLE[c1ientData]; 

RETURN [SetMapItems [formWindow, iconParm.mapProps, IconParm.heap]]; 
END; -- of SetMapProps 


SetMapItems: PROC [window; Window.Nandie. 

mapProps: K4.MapProperties. 
z: UNCOUNTED ZONE] RETURNS [BOOLEAN]^ 

BEGIN 

current, prior: K4.Mapping; 
itemFrom, itemTo: FW.ItemKey; 
emptyFrom, emptyTo: BOOLEAN: 

IF NOT FW.HasAnyBeenChanged [window] 

OR mapProps = NIL THEN RETURN [TRUE]; 

current *■ mapProps.map ; 

FOR itemFrom «- 1, itemFrom *■ 2 
WHILE itemFrom < FW.NumberOfItems[window] DO 
itemTo «* itemFrom + 1; 

IF FW.HasBeenChanged [window. itemFrom] THEN 

current.from «- UpdateBody [window. itemFrom, @current.from. z]: 
IF FW.HasBeenChanged [window, itemTo] THEN 

current.to <- UpdateBody [window,' itemTo, ©current.to, zj; 

emptyFrom «- XS. Empty [Scurrent. from]; 
emptyTo «- XS.Empty [@current.to]; 

SELECT TRUE FROM 

emptyFrom AND NOT emptyTo -> 

BEGIN 

Msg ["Please Fill Left Field or clear Right Field"L]; 

FW,SetInputFocus [window, itemFrom]: 

RETURN [FALSE]; 

END; 

emptyFrom AND emptyTo = > 

BEGIN 

-- remove empty pair 

mapProps . number «• mapProps . number - 1; 

XS.FreeReaderBytes [©current.from, z]; 

XS.FreeReaderBytes [©current.to, z]; 

IF current = mapProps.map THEN -- empty pair is first 
BEGIN 

mapProps .map «- current. next: 
z.FREE [©current]; 
current *- mapProps .map ; 
prior «* mapProps .map ; 

END . 

ELSE 

BEGIN 

prior.next *• current. next; 
z.FREE [©current]; 
current <* prior.next 
END; 

END; 

ENDCASE => 

BEGIN 

prior *- current; 
current <- current.next; 

END; 

ENDLOOP; 

RETURN [TRUE]; 

END; --of SetMapItems 


«.= = = = = = = = = PRIVATE PROCEDURES FOR FONT SUBWINDOW = = * = = = = = = =» 


MakeFontOptions: FW.MakeltemsProc = 

BEGIN 

parm: K4.ConvertParms *• LOOPHOLE[cl IentData] ; 
MakeFontltems [window, parm.fonProps, parm.zone]; 
END; -- of MakeFontOptions 


MakeFontProps : FW .MakeltemsProc *- 
BEGIN 

iconParm: K4.IconParm$ *■ LOOPHOLE[cl ientData] ; 
MakeFontltems [window. iconParm.fonProps, IconParm.heap]; 
END; -- of MakeFontProps 
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MakeFontltems: PROC [window: W1ndow.Handle, 

fonProps: K4.FontProperties, 
z: UNCOUNTED ZONE] - 

BEGIN 

label: XS.ReaderBody; 

fontXhoices: FW.Choiceltems «■ DESCRIPTOR [fCholces]; 
fChoices: ARRAY [0..3) OF FW.Choiceltem <- [ 

[string [choiceNumber: FontStyle.modern.ORD, 

string : XStrlng.FromSTRING[”Modern"L]]], 
[string [choiceNumber: FontStyle.classic.ORD, 

string: XString.FromSTRING["ClassiC'L]]], 
[string [choiceNumber: FontStyle.titan.ORD, 

string: XString.FromSTRING[ M Titan”L]]] ]; 

sizeChoices: FW.Choiceltems «- DESCRIPTOR [sChoices]; 
sChoices: ARRAY [0..5) OF FW.Choiceltem «- [ 

[string [choiceNumber: 0, 

string: XString . FromSTRING[ , '8”L]]] , 
[string [choiceNumber: 1, 

string: XString.FromSTRING[”10"L]]], 
[string [choiceNumber: 2, 

String: XString.FromSTRING["12"L]]], 
[string [choiceNumber: 3, 

string: XString.FromSTRING["14"L]]], 
[string [choiceNumber: 4, 

string: XString.FromSTRING["18"L]]] ]; 
MakeFontltems: PROC [fontNumber: CARDINAL, 

styleKey: K4.Fontltems, 
sizeKey: K4.Fontltems, 
ital icsKey.: K4 . Fontltems . 
boldKey: K4. Fontltems] ■= 

BEGIN 

tagstring: LONG STRING *- "Font x"L; 

tagString[tagString. length - 1] *■ '0 + VAL[fontNumber]; 
fonProps.tagSizefstyleKey] «* Measure [©label. tagStringJ; 
fonProps . tagSi ze[s i zeKey] «- 0 : 
fonProps . tagSize[boldKey] <- 0; 
fonProps . tagSize[ i tal icsKey] «- 0: 

EW.MakeChoiceltem[ 
window: window, tag: ©label. 
myKey: styleKey.ORD, 
fullyDisplayed: FALSE, 
values: fontChoices, 

initChoice: VAL[fonProps.fonts[fontNumber].font|]; 
FW.MakeCho1ceItem[ 
window: window, tag: NIL, 
myKey: sizeKey.ORD, 
fullyDisplayed: FALSE, 
values: sizeChoices, 

initChoice: VAL[fonProps.fonts[fontNumber].size]]; 
FW.MakeBoo1eanItem[ 
window: window, tag: NIL, 
myKey: boldKey.ORD, 

label: [string [XString.FromSTRING["Bold"L]]], 
initBoolean: fonProps.font$[fontNumber].bold]; 

FW.MakeBooleanltem[ 
window: window, tag: NIL, 
myKey: italicsKey.ORD, 

label: [string [XString.FromSTRING["Italics"L]]], 
initBoolean: fonProps.fonts[fontNumber].italics]: 

END; --of MakeFontltems 


IF fonProps.tagSize = NIL THEN 
fonProps . tagSize *■ z ,NEW[ FontTagSizes]; 

-- released by FreeFontProps 


MakeFontltems 

[0. 

fontO, 

MakeFontltems 

[1. 

fontl, 

MakeFontltems 

[2. 

font2. 

MakeFontltems 

[3. 

font3, 

MakeFontltems 

[4. 

font4, 

MakeFontltems 

[5. 

font5, 

MakeFontltems 

[13, 

font6, 

MakeFontltems 

[7. 

font7, 

MakeFontltems 

[8. 

font8, 

MakeFontltems 

[9. 

font9, 

END; -- of MakeFontltems 


s1zeO, 

ital 

icsO, 

boldO] 

sizel, 

ital 

ic$t, 

boldl] 

size2, 

ital 

ics2, 

bold2] 

size3, 

i tal 

ic$3, 

bo ld3] 

$1ze4, 

ital 

ics4. 

bold4] 

size5, 

ital 

ics5, 

bold5] 

size6, 

ital 

ics6, 

boldG] 

size?. 

ital 

ics7, 

bold7] 

sizes, 

1 tal 

ics8, 

bold8] 

si ze9, 

Ital 

ics9. 

bold9] 


LayFontOptions: FW.LayoutProc = 

BEGIN 

parm: K4.ConvertParms * LOOPHOLE[clientData]; 
LayFontltems [window, parm.fonProps, parm.zone]; 
END; -- of LayFontOptions 


LayFontProps: FW.LayoutProc = 

BEGIN 

iconParm: K4 .IconParms «- LOOPHOLE[cl ientData]; 
LayFontltems [window, iconParm,fonProps, iconParm.heap]; 
END; -- of LayFontProps 


LayFontltems: PROC [window: Window.Handle, 

fonProps: K4.FontPropertles, 
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z: UNCOUNTED ZONE] = 

BEGIN 

margin: CARDINAL = 5; 
maxtag: CARDINAL «- 0; 
line: FW.Line; 

ts : LONG POINTER TO FontTagSIzes *■ fonProps. tagSize: -- accelerator 

LaySingleltem: PROC [ItemKey: K4.Fontltems, 

tagSize, interline: CARDINAL] = 

BEGIN . 

IF interline > 0 THEN 

line *• FW.AppendLine[window: window. 

spaceAboveLine: interline]; 
FW.AppendItem[window: window, line: line, 
item: itemKey.ORD, 
preMargin: IF Interline = 0 THEN S 

ELSE Pre$pace[tagSize, maxTag, margin]]; 
END; -- of LaySingleltem 

FOR k: Fontltems IN Fontltems DO 
maxTag *■ MAX [maxTag, f onProps . tagSize[k]] ; 

ENDLOOP; 

LaySingleItem[fontO. tsffontO], G]; 

LaySingleltem[size0, ts[sizeO], 0]; 

LaySingleltem[italicsO, ts[italicsO], Oj; 

LaySingleItem[boldO, ts[boldO], 0]; 

LaySingleItem[fontl. ts[fontl], 6]; 

LaySingleItem[sizel, ts[sizel], 0]; 

LaySingleItem[italicsl, ts[italics1]. 0 ]; 

LaySing le-£tem[boldl, tsfboldl], 0]: 

LaySingleltem[font2. ts[font2], 6]; 

LaySingleItem[size2. ts[size2], 0]; 

LaySingleItem[italics2. ts[italics2], 0]; 

LaySingleItem[bold2. ts[bold 2 ]. 0 ]; 

LaySingleItem[font3, ts[font3], 6]; 

LaySi.ngleItem[size3. ts[size3], 0]: 

LaySingleltem[italics3, ts[italics3], 0]: 

LaySingleltem[bold3, ts[bold3], 0 ]; 

LayS inglel tem[font.4, t$[font4], 6]: 

LaySingleItem[size4, t$[$ize4], 0]; 

LaySingleltem[italics4, ts[italics4], 0]; 

LaySinglertem[bold4, ts[bold4], 0]; 

LayS ingleItem[font5, ts[font5], 6]; 

LayS1ngleItem[size5. ts[size5], 0]: 

LaySingleltem[italics5, ts[italics5],0]; 

LaySlngleItem[bold5. ts[bold5], 0]; 

LaySingleItem[font6, ts[font6], 6]; 

LaySing1eItem[size6. ts[size6], 0 ]; 

LaySingleItem[italics6, ts[1talics6], 0 ]; 

LaySingleItem[bold6, ts[bold0], 0]; 

LaySingleItem[font7, ts[font7], 6]; 

LaySingleItem[size7, ts[slze7], 0]; 

LayS1ngleItem[italics7, ts[italics7], 0]; 

LaySingleItem[bold7, ts[bold7], 0]; 

LaySingleItem[font8, ts[font8], 6]; 

LaySingleItem[size8, ts[s1ze8], 0]; 

LaySingleItem[italics8, ts[italics8], 0]; 

LaySingleItem[bold8. ts[bold8], 0]; 

LaySingleItem[font9. ts[font9], 6]; 

LaySingleItem[size9, ts[s1ze9]. 0]; 

LaySingleItem[italics9, t$[italics9], 0 ]; 

LaySingleItem[bold9, ts[bold9], 0]; 

FW.Repaint [window]; 

END; -- of LayFontltems 


SetFontOptions: PropertySheet.MenuItemProc = 

BEGIN 

parm: K4 .ConvertParms *■ LOOPHOLE[cl ientData] ; 

RETURN [SetFontltems [formWindow, parm.fonProps, parm.zone]]; 
END; — of SetFontOptions 


SetFontProps: PropertySheet.MenuItemProc = 

BEGIN 

iconParm; K4.IconParms *■ LOOPHOLE[cl ientData]; 

RETURN [SetFontltems [formWindow, iconParm.fonProps, iconParm.heap]]: 
END; -- of SetFontProps 


SetFontltems: PROC [window: Window.Handle, 

fonProps: K4.FontProperties, 
z: UNCOUNTED ZONE] 

RETURNS [BOOLEAN] * 

BEGIN 

Boolean: PROCEDURE [item; Fontltems] RETURNS [BOOLEAN] - INLINE 
(RETURN [FW.GetBooleanltemValue [window, Item.ORD]]}; 

Choice: PROCEDURE [item: Fontltems] RETURNS [CARDINAL] = INLINE 
(RETURN [FW.GetCholceltemValue [window, item.ORD] ]}; 

IF NOT FW.HasAnyBeenChanged [window] THEN RETURN [TRUE]; 

fonProps . fonts[0] .font «■ VAL [Choice [K4. Fontltems . fontO]] ; 
fonProps . fonts[0].size «• VAL [Choice [K4. Fontltems .sizeO]]; 
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fonProps .fonts[0] .bold *- Boolean [K4.Fontltems.boldO]; 
fonProps.fonts[0]. italics «■ Boolean [K4.Fontltems. ital icsO] ; 
fonProps.fonts[l],font *• VAL [Choice [K4.Fontltems.fontl]]; 
fonProps. fontsfl]. size *■ VAL [Choice [K4. Fontltems . sizelj]; 
fonProps.fonts[l].bold <- Boolean [K4. Fontltems.boldl]: 
fonProps .fonts[l]. Ital ics +■ Boolean [K4. Fontltems. ital icsl]: 
fonProps. fonts[2]. font «- VAL [Choice [K4. Fontltems .font2]] ; 
fonProps. fonts[2]. size +• VAL [Choice [K4.Fontltems.size2]]; 
fonProps.fonts[2].bold «- Boolean [K4.Fontltems .bold2] ; 
fonProps,fonts[2].italics «• Boolean [K4. Fontl terns . ital ics2] : 
fonProps. fonts[3], font <- VAL [Choice [K4.Fontltems.font3]]; 
fonProps.fonts[3] .size <- VAL [Choice [K4. Fontl terns . s i ze3]] ; 
fonProps. fonts[3] ..bold <• Boolean [K4. Fontl terns . bold3] ; 
fonProps . fonts[3] . ital ics «- Boolean [K4. Fontltems . ital ics3] ; 
fonProps. fonts[4]. font «- VAL [Choice [K4. Fontl terns . font4] ]; 
fonProps .fonts[4].size «- VAL [Choice [K4.Fontltems.size4]]; 
fonProps . fonts[4] .bold «- Boolean [K4. Fontltems .bold4] ; 
fonProps .fonts[4], italics «■ Boolean [K4.Fontltems. ital ics4]; 
fonProps . fonts[5] . font «- VAL [Choice [K4 . Fontltems . font5]]; 
fonProps.fonts[5],size *- VAL [Choice [K4. Fontl terns . s ize5 ]]; 
fonProps. fonts[5J. bold <- Boolean [K4. Fontltems .bold5]: 
fonProps . fonts[5] . ital ics «- Boolean [K4. Fontl terns . ital ics5] ; 
fonProps . fonts[6] . font «■ VAL [Choice [K4.Fontlterns.font6]]; 
fonProps .fonts[6],size. *- VAL [Choice [K4. Font! terns. size6] ]; 
fonProps . fonts[6] .bold «- Boo lean [K4. Fontltems .bo 1 d6] ; 
fonProps . fonts[6] . italics *■ Boolean [K4. Fontl terns. ital ics6]; 
fonProps. fonts[7].font «• VAL [Choice [K4. Fontltems . font7]J ; 
fonProps . fonts[7] . size «• VAL [Choice [K4. Font I terns . size?]] ; 
fonProps .fonts[7] ,bold «■ Boolean [K4 . Font! terns .bold7] ; 
fonProps . fonts[ 7] . i tal i cs Boolean [K4. Fontl terns. ital ics 7]: 
fonProps.fonts[8],font *■ VAL [Choice [K4.Fontlterns.font8]J; 
fonProps . fonts[8] ,s i ze *- VAL [Choice [K4, Fontl terns . size8 ]]; 
fonProps . fonts[8] .bold *■ Boolean [K4 . Fontl terns .bold8] ; 
fonProps . f-onts[8] . ital ics *■ Boo lean [K4 . Fontltems . ital ics3 ]; 
fonProps . fonts[9] . font *■ VAL [Choice [K4 . Fontltems .font9]]; 
fonProps . fonts[9] . size *- VAL [Choice [K4.Fontlterns.size9]]; 
fonProps .fonts[9] .bold «- Boolean [K4 . Fontltems .bold9]; 
fonProps . fonts[9] . ital ics *■ Boolean [K4 . Fontl terns . ital ics9] ; 

RETURN [TRUE]; 

END; - of SetFontltems 


<<========== PRIVATE PROCEDURES FOR GENERAL SUBWINDOW ==========>> 


MakeGeneralItems: FW.MakeltemsProc = 

BEGIN 

iconParm: K4.IconParms *■ LOOPHOLE[cl ientData] ; 
label: XS.ReaderBody; 

speedChoices: FW.Choiceltems «- DESCRIPTOR [sChoices]; 
sChoices: ARRAY [0..3) OF FW.Choiceltem «• [ 

[string [choiceNumber: 0, 

string: XString.FromSTRING["9600"L]]], 

[string [choiceNumber: 1, 

string: XString . FromSTRING["4800 ,, L]]] , 

[string [choiceNumber: 2, 

string: XString.FromSTRING["300"L]]] ]; 

IF iconParm.genProps.tagSize = NIL THEN 

iconParm.genProps . tagSize <- iconParm. heap ,NEW[GeneralTagS1zes] : 

-- released by FreelconProps 

iconParm.genProps.tagSize[iconName] <- Measure[@labe 1. "Icon Name"L]; 
FW.MakeTextItem[window: window, 

myKey: K4.GeneralI terns.IconName.ORD. 
tag: ©label, 

initString: ©iconParm.genProps.iconName, 
width: 200]; 

iconParm.genProps . tagSize[channelSpeed] «- Measure [©label. "RS232C Speed"L]; 
FW.MakeChoiceltem[window: window, 

myKey: K4.General Items.channelSpeed.ORD, tag: ©label. 
fullyDisplayed: FALSE, 
values: speedChoices. 

initChoice: VAL[iconParm.genProps.channel Speed]]; 

iconParm.genProps.tagSize[folderName] «• Measure[@labe 1 , "Transmission Folder Name"L]; 
FW.MakeTextItem[window: window, 

myKey: K4.General I terns.folderNane.ORD, 
tag: ©label. 

initString: ©IconParm.genProps.folderName, 
width: 200]: 

iconParm .genProps . tagSize[others] «- Measure[@label . "Required Tailor Choices"L]; 

FW.MakeTextItem[window: window, 

myKey: K4.GeneralItems.others.ORD, 
tag: ©label, 

InitString: ©iconParm.genProps.others. 
width: 300, boxed: FALSE, readonly: TRUE]; 

END: --of MakeGeneralItems 


K4PSheetImpl.mesa 


28-Apr-87 16:59:07 PDT 


10 







LayGoneralItems: FW.LayoutProc = 

BEGIN 

iconParm: K4. IconParms LOOPHOLE[cl IentData]; 

margin: CARDINAL =5; 

spaceBetweenLines: CARDINAL = 3; 

inaxTag: CARDINAL «• 0; 

line: FW.Line; 

FOR k: K4.General Items IN K4.General Items DO 
maxTag <- MAX [maxTag. iconParm.genProps . taqSize[kl 1; 

ENDLOOP; L JJ 

line <- FW.AppendLine[w1 ndow: window, 

spaceAboveLlne: 2 * spaceBetweenLines1; 

FW.Appendltemf 

window: window, item: K4.General Items.iconName.ORD, line: line, 
preMargin: Prespace[iconParm.genProps.tagSize[iconNameJ, maxTag, margin]]; 

line «- FW.AppendLine[window: window, 

spaceAboveLine: 2 * spaceBetweenLines]; 

FW.AppendItem[ 

window: window, item: K4.General Items.channel Speed.ORD. line: line, 
preMargin: Prespace[iconParm.genProps.tagSize[channelSpeed]. maxTag, margin]]; 

line *- FW.AppendLine[window: window, 

spaceAboveLine: 2 * spaceBetweenLines]; 

FW.Append!tem[ 

window: window, item: K4.General I terns.foIderName.ORD, line: line, 
preMargin: Prespace[iconParm.genProps.tagSize[fo1derName]. maxTag. margin]]; 

line *■ FW.AppendLine[window: window, 

spaceAboveLine: 4 * spaceBetweenLines]; 

FW.Appendltemf 

window: window, item: K4.General I terns.others.ORD, line: line, 
preMargin: Prespace[iconParm.genProps.tagSize[others], maxTag, margin]]: 

FW.Repaint [window]; 

END; -- of LayGeneralItems 


SetGeneralI terns: PropertySheet.MenultemProc = 

BEGIN 

nsSelections: NSFile.Selections <- []; 
nsName: NSString.String; 

attributeList: ARRAY[0.,1) OF NSFile.Attribute; 
ps: K4. IconParms *■ LOOPHOLE[c1ientData]; 

IF FW.HasBeenChanged [formWindow, General Items.iconName.ORD1 THEN 
BEGIN 

ps .genProps . iconName «■ UpdateBody [formWindow, 

General Items.iconName.ORD, 

Ops.genProps.iconName, 
ps.heap]; 

IF XS.Empty [Ops.genProps.IconName] THEN 
BEGIN 

Msg ["Icon name cannot be empty"Ll; 

RETURN [FALSE]; 

END; 

nsName *■ XS.NSStringFromReader [Ops .genProps . iconName , ps.heap]; 
at tributeList[0] «- [name [nsName]]; 

NSFile.ChangeAttributes [ps.iconFile, DESCRIPTOR[attributeList]]; 
NSString.FreeString [ps.heap, nsName]: 

END; 

IF FW.HasBeenChanged [formWindow, General Items.folderName,ORD] THEN 
BEGIN 

ps .genProps .folderName «- UpdateBody [formWindow, 

Generalltems.folderName.ORO. 
Ops.genProps.folderName, 
ps.heap]; 

IF XS.Empty [Ops.genProps.folderName] THEN 
BEGIN 

Msg ["Folder name cannot be empty"LI; 

RETURN [FALSE]; 

END; 

END; 

ps .genProps.channelSpeed *■ VAL [FW.GetChoiceItemValue[ 

formWindow, 

K4.General Items,channelSpeed.ORD]]: 

RETURN [TRUE]; 

END; -- of SetGeneralItems 


<< = i = = B ^ as = " PRIVATE PROCEDURES FOR LINK SUBWINDOW = = - = - =====>> 


MakeLinkOptions: FW.MakeltemsProc = 

BEGIN 

parm: K4 .ConvertParms <- LOOPHOLE[c1 ientData] ; 
sheetChoices: FW.Choiceltems <- DESCRIPTOR [sCholces]; 
sChoices: ARRAY [0..3) OF FW.Choiceltem *• [ 

[string [cholceNumber: 0, 

string: XString.FromSTRING["Document"L]]], 
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[string [cholceNumber; 1, 

String: XString.From$TRING["Mapping"L]]], 
[string [cholceNumber: 2, 

string: XString.FromSTRING["Fonts"L]]] ]; 

MakeLinkltems [window, sheetChoices. 0, SwapOptions]; 

END; --- of MakeLinkOptions 


MakeLinkProps: FW.MakeltemsProc = 

BEGIN 

iconParm: K4.IconParms «- LOOPHOLE[cl ientData] ; 
sheetCho ices: FW.Choiceltems *■ DESCRIPTOR [sChoices]: 
sChoices: ARRAY [0..4) OF FW.Choiceltem «- [ 

[string [choiceNumber: 0, 

String: XString.FromSTRING["Icon"L]]], 
[string [cholceNumber: 1, 

String: XString.FromSTRING["Document"L]]], 
[string [choiceNumber: 2, 

String: XString.FromSTRING["Mapping”L]]], 
[string [choiceNumber: 3. 

String: XString.FromSTRING["Font"L]]] J; 

MakeLinkltems [window, sheetChoices, I, SwapProps]; 

END; -- of MakeLinkProps 


MakeLinkltems: PROC [window: Window.Handle, 

choices: FW.Choiceltems, 
firstChoice: FW.ltemKey, 
swapProc: FW.Cho iceChangeProc] =■ 

BEGIN 

label: XS.ReaderBody <- XS. FromSTRING[ "Sheet for: "LJ; 

FW.MakeChoiceItem[window: window, 

myKey: 0, tag: @label, 
values: choices. 
initChoice: firstChoice. 
changeProc: swapProc]; 

END; of MakeLinkltems 


LayLinkltem: FW.LayoutProc = 

BEGIN 

line; FW.Line *■ FW.AppendLine[window: window, 

spaceAboveLine: 9]; 

FW.AppendItem[window: window, item: 0, line: line, preMargin: 5]; 
END: -- of LayLinkltem 


SwapOptions: FW.ChoiceChangeProc * 

BEGIN 

parm: K4 .ConvertParms <-LOOPHOLE[FW.GetCl ientData [window]]; 

newMake: FW.MakeltemsProc: 

newLay: FW.LayoutProc; 

newSet: PropertySheet.MenuItemProc; 

SELECT newValue FROM 

0 => (newMake «- MakeTextOpt ions ; 

newLay *■ LayTextOpt ions : 
newSet <- SetTextOptions}; 
l => (newMake «- MakeMapOp t ions ; 

riewLay *• LayMapOpt ions ; 
newSet «- SetMapOptions}; 

ENDCASE => (newMake <- MakeFontOpt ions: 

newLay «- LayFontOpt ions ; 
newSet *- SetFontOptlons): 

[] ♦* PropertySheet.SwapFormWindows [ 
shell: parm.optionSheet, 
apply: TRUE, 

newFormWindowItems: newMake, 
newFormWindowIternsLayout: newLay, 
newMenuItemProc: newSet]: 

END; -- of SwapOptions 


SwapF’rops: FW.ChoiceChangeProc ■ 

BEGIN 

iconParm: K4. IconParms «- LOOPHOLE[FW .GetCl ientData [window]]; 

newMake: FW.MakeltemsProc: 

newLay: FW.LayoutProc; 

newSet: PropertySheet.MenuItemProc: 

SELECT newValue FROM 

1 => (newMake <- MakeTextProps: 

newLay *■ LayTextProps; 
newSet «■ SetTextProps); 

2 => (newMake *■ MakeMapPropsj 

newLay «- LayMapProps; 
newSet «* SetMapProps); 

3 => (newMake *■ MakeFontProps: 

newLay «* LayFontProps; 
newSet *■ SetFontProps}; 

ENDCASE => (newMake «* MakeGeneral I terns; 

newLay «- LayGeneral I terns ; 
newSet «- SetGeneral Items} : 

28-Ap'r-87 16:59:07 PDT 
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[] *■ PropertySheet.SwapFormWindows [ 

shell: iconParm.propSheet, 
apply: TRUE, 

newFormWindowltems: newMake. 
newFormWindowItemsLayout: newLay, 
newMenuItemProc: newSet]; 

END; -- of SwapProps 


TakeDownPSheet: PropertySheet.MenuItemProc = 

BEGIN 

data: Containee.Data; 
nsSelections: NSF 1 1 e.Selections «■ [J; 
iconParm: K4.IconParms *■ LOOPHOLE[clientData]; 
z: UNCOUNTED ZONE <- IconParm.heap; 

IF menuI tern = done THEN 
BEGIN 

IF iconParm .mapProps ft NIL AND iconParm .mapProps. number = I THEN 
BEGIN - check if only entry is empty 

IF XS,Empty [@ icon'Parm.mapProps.map.from] 

AND XS.Empty [@iconParm.mapProps.map.to] 

THEN iconParm.mapProps . number «■ 0; 

END; 

K4.StoreFi1edData [iconParm]; 

IF iconParm.changeProc ft NIL THEN 
BEGIN 

data <- [reference: NSFi le .GetR.eference[ iconParm. iconF i 1 e]]; 
nsSelections . interpreted[name] «- TRUE: 

iconParm.changeProc [changeProcData: iconParm.changeProcData, 
data: @data, 

changedAttributes: nsSelections, 
noChanges: FALSE]; 

END; 

END; 

K4 .FreelconProps [iconParm.genProps, z]; 

K4 , FreerextProps [iconParm.docProps, z]; 

K4.FreeMapProps [iconParm.mapProps, z]; 

K4 . FreeFontProps [iconParm.fonProps, z]; 

NSFile.Close [iconParm.iconFile]; 
z.FREE [GiconParm]; 

Heap.Delete [z]; 

RETURN [TRUE]; 

END; -- of TakeDownPSheet 


« = = = = == = = * = = OTHER PRIVATE PROCEDURES = = = = = = = = = = >> 


Measure: PROCEDURE[1abel: XS.Reader, string: LONG STRING] 
RETURNS [size: CARDINAL] = 

[label t <- XS.FromSTRING[string] ; 
size *• SimpleTextDisplay .MeasureString[label ] .width} ; 


Prespace: PROCEDURE [size, maxSize, margin: CARDINAL] 
RETURNS [preMargin: CARDINAL] = 

BEGIN 

preMargin *■ margin +■ (maxSize - size) > {IF size = 0 

THEN 8 ELSE 0): 

END: 


UpdateBody: PROC [window: Window.Handle, item: FW.ItemKey, 

oldReader: XS .-Reader, zone: UNCOUNTED ZONE] 
RETURNS [newReaderBody: XS.ReaderBody] => 

BEGIN 

rb : XS.ReaderBody *■ FW. LookAtTextltemValue [window, item]; 

XS. FreeReaderBytes [oldReader. zone]; 
newReaderBody *■ XS.CopyToNewReaderBody [@rb. zone]; 

FW.DoneLookingAtTextltemValue [window, item]; 

END; -- of UpdateBody 


Msg: PROCEDURE [message: LONG STRING] = 

BEGIN 

mscjRB: XS.ReaderBody <- XS.FromSTRING [message]; 
Attention.Post [SmsgRB]'-; 

END; --of Msg 


END. -- of K4PSheetImpl 

l4-Jan-37 15:42:32 created from DestTextPSheetlmpl. 

6-Feb~87 10:12:41 fixed storage leak (folderName/outputName not deallocated). 
12-Mar-87 13:48:25 made SetText/FontOptions PUBLIC. 

16- Mar-87 10:00:54 added signature. 

17- Mar-87 15:37:09 added character mapping. 

26-Mar-87 11:27:35 made channel speed singly-displayed. 

31-Mar-37 1.4:12:20 changes to StoreFi 1 edData, no longer releasing memory. 
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31-Mar-87 16:30:15 tried to fix nexting out of mappings. 

7-Apr~87 17:23:53 Taylor => Tailor. 

13- Apr-87 13:13:26 set mapProps.number to 0 If only entry is empty. 

14- Apr-87 14:32:18 added paragraph properties. 

20-Apr-87 17:45:17 initial value of channel speed not picked up from filed data. 
24-Apr~87 16:56:45 removed canvas property/option sheets. 

27- Apr-87 13:21:20 transmission folder name, page breaks. 

28- Apr-87 16:57:56 checked for empty icon, folder or document names 


K4PSheetImpl.mesa 
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<< File: K4WindowImpl.mesa - 15-Sep~88 9:16:10 

delaBeaujardiere:0SBU North;Xerox (deLaBeaujardiere.PA) 
Copyright (C) 1986 by Xerox Corporation. All rights reserved. 
» 

DIRECTORY Attention, Containee. Environment. Heap. 

K4, MenuData, MessageWindow, 

NSFile, NSFileStream, NSString, Process, 

RS232C, RS232CCorrespondents, RS232CEnvironment. 
Selection, StarDesktop, StarFileTypes, 

StarWindowShel1, StarWindowShel1 Extra2, 

Stream, TIP, Window, XFormat, XString; 

K4WindowImpl MONITOR 

IMPORTS Attention, Heap, K4, MenuData. MessageWindow. 

NSFile, NSFileStream, NSString, 

Process. RS232C, Selection, 

StarDesktop. StarWindowShel1. StarWindowShel 1 Extra2, 
Stream. XFormat, XString 

EXPORTS K4 = 

BEGIN 

OPEN SWS: StarWindowShe11, XS: XString: 


Variables: TYPE = LONG POINTER TO VariableObject; 

VariableObject: TYPE = RECORD [ 

window; Window.Handle. 

channel: RS232C.ChanneIHandle, 

commParamObject: RS232C.CommParamObject, 

data: RS232C.PhysicalRecord, 

windowClosing: BOOLEAN <■ FALSE, 

listener: PROCESS «• NIL]; 


parms: K4.IconParms; 
var's: Variables; 

bufferSize: CARDINAL = 512: 


OpenWindow: PUBLIC PROCEDURE [iconData: Containee.DataHandle, 

changeProc: Containee.ChangeProc. 
changeProcData: LONG POINTER, 
tinylcon: XS.Character] 

RETURNS [shell: SWS.Handle «■ SWS. nul IHandle] = 

BEGIN 

wOims: Window.Dims «- [500. 230]; 

wPlace: Window.Place *■ [50, 30]; 

wLines: CARDINAL «■ 10; 

mismatch: 800LEAN; 

zone: UNCOUNTED ZONE «- Heap.Create [4]: --** why 4? 

-- deleted by Shellclosing 

reconvert: XString. ReaderBody «- XString . FromSTRING[ "Make Documenf'L] ; 
command: ARRAY[0..1) OF MenuData.ItemHandle “ [ 

MenuData.Create Item[ 

zone: zone. 
name: ©reconvert, 
proc: Reconvert]]; 

--get memory for IconParms and fill it 
(freed by ShelIClosing, unless there is 
a software/icon mismatch), 
parms *■ zone,NEW [K4. IconParmsRecord] ; 
parms.heap «■ zone: 

parms. IconFile NSFi 1 e.OpenByReference [iconData. reference]; 

-- closed by Shellclosing 

mismatch «• K4. LoadF 11 edData [parms]; — unloaded by ShellClosing 
IF mismatch THEN 
BEGIN 

msg: XS.ReaderBody <- XS.FromSTRING [ 

"Obsolete Icon does not work with new software"L]; 
Attention.Post [@m$g]; 

NSFile.Close [parms.IconFile]; 
zone.FREE [©parms]; 

Heap.Delete [zone]; 

RETURN [SWS.nulIHandle]; 

END; 

-- get memory for Variable 
-- (will be freed by ShellClosing). 
vars *■ zone .NEW[VariableOb ject] ; 

-- create window shell and message window 
shell *• SWS.Create [namePIcture: tinylcon, 

name: ©parms.genProps.iconName, 
scrolIData: SWS.vani11aScrol1 Data. 
IsCloseLegalProc: ShellClosing]; 

SWS.SetRegularCommands [sws: shell, 

commands: MenuData.CreateMenu [ 
zone: zone, 
title: NIL, 

array: DESCRIPTOR[command]]]; 
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vars.window <- SWS.CreateBody [shell]; 
StarWindowShellExtra2.$etPreferredInteriorDims[$ws: shell , 

dims: wDims]; 

MessageWindow.Create [vars.window, zone, wLines]; 

MsgDate []; 

ReadyRS232C [vars, parms.genProps.channel Speed]; 

vars.1istener «• FORK GetTransmissionAndConvert [vars, parms]; 
END; -- of OpenWindow 


PutFilelnFolder: PUBLIC PROCEDURE [file: NSFile.Handle, 

folderName: NSString.Strinq] = 

BEGIN 

-- This proc puts a file 

-- in the named folder on the desktop. 

-- If the folder Is not found, a new one is created. 

-- If the folder creation fails, we leave the file 
--on the desktop as a last resort... 

dateOrdered: key NSFile.Ordering ; 
folderFile: NSFi le .Handle «- NSF i le . nul IHandle : 
folderAttrs: ARRAY [0..4) OF NSFi1e.Attribute; 
desktopFile: NSFile .Handle «■ NSFile .OpenByReference [ 

StarDesktop.GetCurrentDesktopF He []]: 

BEGIN 

folderAttrs[0] «■ [name [fol derName]] ; 
folderFile *- NSFile.Open [ 

attributes; DESCRIPTOR [BASE[fo1derAttrs], 1], 
directory: desktopFile 
! NSFile.Error => 

BEGIN 

WITH error SELECT FROM 
access => 

SELECT problem FROM 
f i leNot-Found = > 

BEGIN 

dateOrdered . ascending «- TRUE; 

dateOrdered . key «- createdOn: 

fo lderAttrs[ 1] <- [type[StarFi lelypes . fol der]] 

fOlderAttrs[2] *■ [isDirectory [TRUE]]; 

folderAttrs[3] «- [ordering[dateOrdered]] ; 

folderFile *• NSFi 1 e .Create [ 

directory: desktopFile, 
attributes: DESCRIPTOR[folderAttrs]]; 
StarDesktop.AddReferenceToDesktop [ 

NSFi1e.GetReference [folderFile]]; 

END; 

ENDCASE; 

ENDCASE; 

GOTO Done; 

END]; 

EXITS Done s > {}; 

END; 

IF folderFile = NSFile.nulIHandle THEN -- folder creation failed 
StarDesktop.AddReferenceToDe$ktop[NSFi1e.GetReference [file]] 
ELSE 
BEGIN 

NSFile.Move [file, folderFile]; 

NSFile.Close [folderFile]; 

END; 

NSFile.Close [desktopFile]; 

END; -- of PutFilelnFolder 


— PRIVATE PROCEDURES 


ShellClosing: ENTRY SWS.IsCloseLegalProc = 

BEGIN 

ENABLE UNWIND => NULL; 

z; UNCOUNTED ZONE; 

clearMask: RS232C.Dev iceStatus «• [ 

statusAborted: FALSE, dataLost: FALSE, 
breakDetected: FALSE, clearToSend: TRUE, 
dataSetReady: TRUE, carrlerDetect: TRUE, 
ringHeard: FALSE, ringlndicator: FALSE, 
deviceError: FALSE]: 

vars .windowClosing «■ TRUE; 

IF vars.1istener » NIL THEN 

BEGIN 

RS232C.Suspend [vars.channel, all]; 

JOIN vars . I Istener *, 

RS232C.SetParameter [vars.channel, [1atchBitClear [clearMask]]]; 

RS232C.Delete [vars.channel] ; 

vars . 1 Istener *■ NIL; 

END; 

IF parms . changeProc ft NIL THEN parms . changeProc[ 

changeProcData: parms.changeProcData, 
data; parms.iconData, 
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noChanges: TRUE]; 

MessageWindow.Destroy [vars.window]; -- clear message resources 

NSFile.Close [parms.iconFile]; 
z *■ parms.heap; 
z.FREE [@vars]; 

K4 . FreelconProps [parms. genProps , z]; 

K4.FreeTextProps [parms.docProps. z]; 

K4.FreeMapProps [parms.mapProps, z]; 

K4.FreeFontProps [parms.fonProps, z]; 
z.FREE [@parms]; 

Heap.Delete [z]; 

RETURN[TRUE]; 

END; -- of ShellClosing 

Msg: PROC [message: LONG STRING, startOnNewLine: BOOLEAN] = 

BEGIN 

picture: XFormat. Object *■ MessageWindow.XFormatObject [vars .window] ; 
IF StartOnNewLine THEN 
BEGIN 

MessageWindow.PostSTRING [vars.window, " "L, TRUE]; 

XFormat.Date [h: Qpicture, format: timeOnly]; 

MessageWindow.PostSTRING [vars.window, " "L. FALSE]; 

END; 

MessageWindow.PostSTRING [vars.window, message, FALSE]; 

END; -- of M$g 


MsgDate: PROC = 

BEGIN 

« 

pic: XFormat.Object *- MessageWindow.XFormatObject [vars .window ]; 
MessageWindow.PostSTRING [vars.window, " "L. TRUE]: 

XFormat.Date [h; @pic, format: dateOnly]; 

>> 

END; - of MsgDate 


MsgDecimal: PROC [number: LONG CARDINAL] - 
BEGIN 

picture: XFormat .Object *■ MessageWindow.XFormatObject [vars .w indow] ; 
XFormat.DecImaI [h: Qpicture, n: number]: 

END; -- of MsgDecimal 


ReadyRS232C: 
BEGIN 


PROCEDURE [vars: Variables, 

optionSpeed: K4.Channel Speed] = 


speed: RS232C.LineSpeed 


SELECT optionSpeed 

FROM 

ninetySix 

= > 

fortyEight 

= > 

three 

= > 

ENDCASE 

= > 


bps9600 
bps4800 
bps300, 
bps9600 


clearMask: RS232C.DeviceStatus * [ 

statusAborted: FALSE, dataLost; FALSE, 
breakDetected: FALSE, clearToSend: TRUE, 
dataSetReady: TRUE, carrierDetect: TRUE, 
ringHeard: FALSE, ringlndicator: FALSE, 
deviceError: FALSE]; 
vars.commParamObject *■ [duplex: full, 

HneType: asynchronous, 
lineSpeed: speed, 
accessDetai1: directConn[]]; 


vars.channel «• RS232C .Create [ 

UneNumber: RS232C.GetNextLine [RS232C.nulILineNumber], 
commParams: @vars.commParamObject, 
preemptOthers: preemptAlways, 
preemptMe: preemptAlways]; 

RS232C.SetParameter [vars.channel, [charLength [8]]]; 

RS232C.SetParameter [vars.channel, 

[correspondent [RS232CCorrespondents.ttyHost]]]; 

RS232C.SetParameter [vars.channel, [frameTImeout [1000]]]; 

RS232C.SetParameter [vars.channel, [lineSpeed [speed]]]; 

RS232C.SetParameter [vars.channel, [parity [none]]]; 

RS232C.SetParameter [vars.channel, [stopBIts [1]]]; 

RS232C.SetParameter [vars.channel, [latchBitClear [clearMask]]]; 
RS232C.SetParameter [vars.channel, [dataTermlnalReady [TRUE]]]; 
RS232C.SetParameter£vars.channel. [requestToSend [TRUE]]]; 

RS232C.SetParameterfvars.channel, 

[flowControl [[type: xOnXOff, 

xOn: 17, -- DC! (tq) 

xOff: 19]]]]; -- DC3 (r S ) 

END; -- of ReadyRS232C 


GetTransmissionAndConvert: PROCEDURE [vars: Variables. 

parms: K4.IconParms] = 

BEGIN 


byteArray: 
logAttrs: 


logFlie: 
logStream: 
folderName: 


PACKED ARRAY [0..bufferSize) OF Environment.Byte; 

ARRAY[0 . . 2 ) OF NSF11 e .Attribute <- [ 

[name [NSString.StringFromMesaString["K4TEXT.LOG"L]]], 
[type [2]]]; 

NSFile.Handle; 

NSFi1eStream.Handle; 

NSString.String; 
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dots: CARDINAL; -- to count dots announcing reception 

bytesLogged: LONG CARDINAL; 
bytesRecelved: CARDINAL; 

transferStatus: RS232C.TransferStatus; 

Process.SetPriority [Process.priorityNormal]; 
vars.data «• [header: Environment.nullBlock, 

body: [blockPointer: SbyteArray, 
startlndex: 0, 

stopIndexPlusOne: bufferSize], 
trailer: Environment.nullBlock]; 

DO -- run while window is open 
dots *- 0; 
bytesLogged *■ 0; 

Msg ["Waiting for transmission from Kurzweil 40Q0"L, TRUE]: 

[bytesReceived, transferStatus] «■ GetBlock[vars] ; -- request 1st block 

IE vars,windowClosing THEN RETURN; 

Msg [ ,, Receiv1ng ,, L, TRUE]; -- announce Initial reception 
logFile «■ NSFile .Create [directory: NSF i le . nul 1 Handle , 

attributes: DESCRIPTOR[IogAttrs]]; 
logStream «- NSFi 1 eStream.Create [logFile, FALSE]; 

DO 

IF vars.windowClosing THEN 
BEGIN 

Stream.Delete [logStream]; 

NSFile.Close [logFile]; 

RETURN; 

END; 

IF transferStatus ft success THEN EXIT; 

IF bytesReceived = 0 THEN LOOP; 

vars .data.body. stopIndexPlusOne *• bytesReceived; 
bytesLogged *• bytesLogged + bytesReceived; 
dots «- IF dots > 50 THEN 0 ELSE dots + 1; 

Msg ["."L, (dots = 0)]; -- continue announcing block reception 

Stream.PutBlock [logStream, vars.data.body]; 

IF byteArray[bytesReceived -.1] = 200B THEN EXIT; 

[bytesReceived, transferStatus] «• GetBlock[vars]; 

ENDLOOP; 

IF bytesLogged < 5 THEN -- don't bother saving 4 bytes or less,.. 

BEGIN 

Msg [" Less than 5 bytes received. Ignored."L, FALSE]; 

Stream.Delete [logStream]; 

NSFile.Close [logFile]; 

END 

ELSE 

BEGIN 

bytesLogged <- bytesLogged - 1; --to drop the 200B added by K4000 
MsgDecimal [bytesLogged]; 

Msg [" bytes received."L, FALSE]; 

Stream.SendNow [logStream]; 

MSFi 1 eStreani.SetLength [logStream, bytesLogged]; 

Stream.Delete [logStream]; 

folderName <• XS.NSStrlngFromReader [@parms .genProps . fo 1 derName , 

parms.heap]; 

PutFI1elnFolder [logFile, folderName]; 

MSString.FreeStrlng [parms.heap, folderName]; 

Msg ["Spawning document creation."L, TRUE]; 

K4.ConvertToDocument [logFile, parms.docProps, 

parms.mapProps, parms.fonProps]; 

END; 

ENDLOOP; 

END; -- of GetTransmissionAndConvert 


GetBiock: PROC [vars: Variables] 

RETURNS [count: CARDINAL, status: RS232C.TransferStatus] - 

BEGIN 

completlonHandle: RS232C.Complet1onHandle; 

vars .data. body.stopIndexPlusOne «■ bufferSize; 
completlonHandle * RS232C .Get[vars .channel , Ovars.data]; 

[count, status] «• RS232C.TransferWalt[vars.channel , completlonHandle]; 
END; -- of GetBiock 


Reconvert; MenuData.MenuProc = 

BEGIN 

use here selection Interpretation in K4ToVPUti1ity 
OPEN Selection; 

-- User has selected a log stream in document folder 
-- and wants to make a new document from it. 
f i leSelection: Value «* Convert [Target. f ile]; 
typeSelection: Value «■ Convert [Target.f ileType] ; 
typeAscii: NSF He. Type = 2; 

IF fiIeSelection.value * nul1 Value.value 
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OR typeSelectlon.value = nul1 Value.value 
OR typeSelectlon.valuet # typeAscii THEN 
BEGIN 

Msg ["Reconverting: there is no selection to convert."L, 

TRUE]; 

END 

ELSE 

BEGIN 

refLoc: LONG POINTER TO NSFile .Reference «■ 

LOOPHOLE[fileSelection.value]; 
logFlle: NSFile.Handle +■ NSFile.OpenByReference [refLoct]; 

-- file closed by conversion job 
Msg ["Spawning document creation."L, TRUE]; 

K4.ConvertToDocument [logFile, parms.docProps. parms.mapProps, parms.fonProps]; 
END; 

END; -- of Reconvert 


END. -- of K4Windowlmpl 
LOG: 

23-Jan-B7 16:42:05 created from DestTextWindowlmpl and K43Windowlmpl. 

4-Feb-87 11:47:24 moved pSheet items into body window, removed Options command. 

6 -1- e b - 8 7 10:13:34 fixed storage leak ( fol derName/outputName not deallocated). 

Ci-Feb-87 17:58:04 implemented ReceiveScannerData as background job. 

13- feb-87 10:56:09 redid entire RS232C interaction to prevent hanging in RS232C .Suspend-. 

16-Feb-87 14:06:07 added warning sheet to run Editor if idle. 

18-1eb-87 15 :47:10 added inspection of header to determine output type. 

26- F eb-87 17:22:49 implemented IntervalTimer facility because text files from K4000 do not always have etx at the end, and we need to 
time out after a while. 

3- Mar-87 10:20:32 incorporated call to ConvertToCanvas, reguest to run VP Free-hand Drawing, etc... 

4- Mar-87 15:58:47 made PutFilelnFolder a public proc. 

10- Mar-87 14:24:23 adapted to linked property sheet, removed panel window in preparation of installing history window. 

11- Mar-87 14:05:31 turned into a message window. 

12- Maf-87 10:58:39 fixed messages/transmission coordination. 

16-Mar-87 10:12:10 added signature. 

18- Mar-87 14:38:46 cleared channel mask bits after deleting. 

19- Mar-87 10:12:40 mapPropS not initialized in SpinOffDocument. 

23- Mar-87 15:21:14 added Reconvert command. 

24- Mar-87 13:30:21 ordering folder by creation date. 

2-Apr-87 10:43:20 saving/naming of logFile moved to KJCanvasImpl or K4DocumentImpl, 

6- Apr-87 15:45:27 creation of ConvertParms moved from here to K4Documentlmpl and K4Canvaslmpl. 

7 Apr-87 13:54:40 removed useless start code. 

7- Apr-87 14:28:32 moved back here saving of logFile; had problem with holding same handle in two processes. 

97Apr-87 11:46:09 Looks like the logFile does not have all the data received; so now using block/PutBlock instead of string/PutString to 
save bytes received from channel. 

14- Apr-87 14:44:48 removed saveLog. 

15- Apr-87 15:07:44 remove flow control on RS232C channel, set timeout to 1000 millisecs. 

18-Apr-87 16:27:55 restored flow control (still no clues about lost bytes: tried slower baud rates, larger timeouts, 7 bits, high 
priority processes, flow control/no flow control, larger buffers, ..). 

20- Apr-87 14:48:27 truncated the log stream by one byte because it seems that we always get one extra byte (2008) at the end, perhaps 
generated by the Suspend[channel]. 

20-Apr-87 14:49:40 picked up channel speed from option sheet. 

20-Apr~87 18:09:56 adjusted length of silence to channel speed. 

24-Apr-87 16:43:38 dropped canvas and ArtScan processing. 

27- Apr-87 10:08:52 "Reconvert" becomes "Make Document". 

27-Apr-87 13:25:32 transmission folder name. 

14- Sep~88 9:59:55 discovered that in VP2.0, we no longer get the last block; perhaps something with the 5 seconds wait in lower priority 
process: also discovered with DLM that the last byte of last transmission, 80X, is sent by Kurzweil, not added by Suspend or some such; 
thus, the code to wait a while to see if transmission is ended is replaced by testing 80X. 

15- Sep-88 9:13:53 cleared latch bits before deleting channel: I noticed that the DEST claims that the port is not ready after Kurzweil 
application has been used; perhaps clearing the latch bits will help. 

/ 
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— OcialConvertToolImp!.mesa 

-- Trow:PARC:Xerox 7-Sep-89 21:37:23 

— Copyright (c) 1989 by Xerox Corporation. All rights reserved. 

DIRECTORY 

Ascii USING [CR, SP], 

Environment USING [Byte], 

Event USING [DoneWIthProcess, Handle, StartlngProcess, toolWIndow], 

EventTypes USING [deactivate]. 

Exec USING [AddCommand, ExecProc, RemoveCommand], 

FormSW USING [A1locateltemDescrlptor, Booleanltem, CllentltemsProcType, 
Commandltem, ItemHandle, UneO, Unel, 11ne2, ProcType, Stringltem], 

Heap USING [Create, Delete], 

Inline USING [BITAND, BITSHIFT], 

MFIle USING [Type], 

MStream USING [Error, GetLength, Readonly, SetLength, WrlteOnly], 

Process USING [Detach], 

Put USING [Line, Text], 

Runtime USING [GetBcdTime], 

Stream USING [Delete, EndOfStream, GetChar, GetByte, Handle, PutByte, PutChar, 
PutString], 

String USING [AppendLongNumber, AppendStrlng], 

Supervisor USING [AddDependency, AgentProcedure, CreateSubsystem, 
EnumeratlonAborted , RemoveDependency, SubsystemHandle] , 

Time USING [Append, AppendCurrent, Unpack], 

Tool USING [Create, Destroy, MakeFIleSW, MakeFormSW, MakeMsgSW, MakeSWsProc, 
UnusedLogName], 

ToolWIndow USING [Activate, GetState, TransItionProcType], 

Window USING [GetChlld, GetParent, Handle, Stack, ValIdateTree]; 

OctalConvertToolImpl: PROGRAM 

IMPORTS Event, Exec, FormSW, Heap, Inline, MStream, Process, Put. 

Runtime, Stream, String, Supervisor, Time, Tool, ToolWIndow, Window 

BEGIN 


-- Types 


Formlndex: TYPE = (protectBlnary, blnaryFIle, protectOctal, octalFile, blnaryToOctal, 
octalToBinary}; 

Tool Data: TYPE = MACHINE DEPENDENT RECORD [ 
msgSW(O): Window.Handle NIL, 
formSW(2): Window.Handle «■ NIL, 
logSW(4): W1 ndow.Handle «■ NIL, 
protectBinary(6): BOOLEAN «• TRUE, 
protectOctal(7): BOOLEAN «• TRUE, 
b1naryF11eName(8): LONG STRING <- NIL, 
octalF11eName( 10): LONG STRING «- NIL, 
commandIsRunn1ng( 12): BOOLEAN <- FALSE]; 


Constants 


agent: Supervisor.SubsystemHandle = Supervisor.CreateSubsystem[CheckDeact1vate]; 


-- Globals 


data: LONG POINTER TO ToolData *■ NIL; 
wh: Window.Handle «■ NIL; 
heap: UNCOUNTED ZONE <• NIL; 


— InitialIzatlon 


Init: PROC - 
BEGIN 

Exec.AddCommand["OctalConvertTool.~"L, MakeTool, NIL, Unload]; 

END; -- Init 

MakeTool: Exec.ExecProc - 
BEGIN 

IF wh = NIL THEN 
BEGIN 

name: LONG STRING <- [60]; 

String.AppendStr1ng[to: name, from : "Octal Convert Tool of "L]i 
Time.Append[s: name, unpacked: Time.Unpack[Runt1me,GetBcdTime[]]J; 
name.length *■ name, length - 3; — lop the seconds 
wh «- Tool .Create[name: name, makeSWsProc: MakeSWs, 

clIentTransItion; CllentTransition, cmSection: "OctalConvertTooVL, 
tlnyNamel; "Octal"L, t1nyName2: "Convert"L]; 

END 

ELSE IF ToolWIndow.GetState[wh] = active THEN 
BEGIN 

newSIbllng; W1ndow.Handle = Window.GetChild[Window.GetParent[wh]] ; 

IF wh M newSIbllng THEN { 

Window.Stack[wh, newSIbllng]; Window.ValidateTreefwh]}; 

END 

ELSE 

Tool Window.Activate[wh]; 
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END; — MakeTool 


Unload: Exec.ExecProc = 

BEGIN 

IF wh # NIL THEN [Tool.Destroy[wh]; wh «- NIL}; 
Exec.RemoveCommand[h, "OctalConvertTool.~"L]; 
END; — Unload 


-- State change 


CheckDeactlvate: Supervisor.AgentProcedure = 

BEGIN 

IF event = EventTypes.deactivate AND wh # NIL 
AND wh = eventData AND data.commandlsRunnlng THEN 
BEGIN 

Put.L1ne[data.msgSW, "Tool Is busy!"L]; 

ERROR Supervisor.EnumerationAborted; 

END; 

END; — CheckDeactlvate 

CHentTransItlon: ToolWIndow.TransItlonProcType = 

BEGIN 

SELECT TRUE FROM 
old = Inactive => 

BEGIN 

IF heap = NIL THEN heap Heap.Create[1nitial : 1, Increment: 1]; 

IF data = NIL THEN data <- heap . N£W[ToolData <- []]; 

END; 

new = Inactive => 

BEGIN 

Supervisor.RemoveDependency[cllent; agent, implementor: Event.toolWIndow]; 
IF data # NIL THEN heap.FREE[@data] ; 

IF heap # NIL THEN {Heap,Delete[heap] ; heap *■ NIL}; 

END; 

ENDCASE; 

END; -- CllentTransItion 


-- Tool window 


MakeSWs: Tool.MakeSWsProc * 

BEGIN 

logFIleName: STRING = [50]; 

Tool .UnusedLogName[unused : logFIleName, root; "OctalConvertTool.log"L]; 

data.msgSW +■ Tool .MakeMsgSW[wlndow: window]; 

dota.formSW * Tool.MakeFormSW[w1ndow: window, formProc: MakeForm]; 

data.logSW Tool .MakeFileSW[w1ndow: window, name; logFIleName]; 

Supervisor.AddDependency[cllent: agent, implementor; Event.toolWlndow]; 

END; — MakeSWs 

MakeForm: FormSW.ClientltemsProcType = 

BEGIN 

OPEN FormSW; 

nltems: CARDINAL = Formlndex.LAST.ORD + 1; 

Items *■ AllocateItemDescriptor[nItems]; 

items[FormIndex.protectBlnary.ORD] *■ BooleanItam[ 

tag: "ProtectBInary"L, place: [0, llneO], switch; Qdata.protectBinary]; 

Items [Form Index .blnaryFIle .ORD] *- Stringltem[ 

tag: "Binary F11e"L, place: [100, lineO], InHeap: TRUE, 
string: Qdata.binaryFIleName]; 

1tem$[FormIndex,protectOctal .ORD] «- BooleanItem[ 
tag: "ProtectOctal"L, place: [0, linel], switch: Qdata.protectOctal]; 

1 tems[FormIndex .octalFlle .ORD] *■ Stringltem[ 
tag: "Octal F11e"L, place: [100, linel], InHeap: TRUE, 

String: @data.octal FI 1eName]; 

1tem$[FormIndex .binaryToOctal .ORD] «• CoimnandItem[ 

tag: "Convert Binary To OctaT'L, place: [0, 11ne2], proc: Convert]; 

Items [Formlndex . octal ToBI nary .ORD] *■ CommandItem[ 
tag: "Convert Octal To B1nary"L, place: [200, 11ne2], proc: Convert]: 

RETURN[items: Items, freeDesc: TRUE]; 

END; -- MakeForm 


Convert procs 


Convert: FormSW,ProcType = 

BEGIN 

IF data.commandlsRunning THEN 

Put.Line[data.msgSW, "Tool Is busy!"L] 

ELSE 

BEGIN 

convertProc: PROC <■ SELECT index FROM 

Formlndex.binaryToOctal.ORD => BinaryToOctal, 
Formlndex.octalToBlnary.ORD => OctalToBinary, 
ENOCASE => ERROR: 
data. commandl sRunn I ng *■ TRUE; 

Process.Detach[FORK convertProc[]]; 

END; 

END; -- Convert 

BinaryToOctal: PROC = 

BEGIN 

PutByteOctal: PROC [byte: Envlronment.Byte] = 
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BEGIN 

NlbbleToChar: PROC [n: CARDINAL] RETURNS [c: CHAR] = INLINE 
BEGIN 

C «- SELECT n FROM 

IN [0. .7] => VAL[0RD['0] + n], 

ENDCASE *> ERROR; 

END; — NlbbleToChar 

Stream.PutChar[octalStream, NibbleToChar[Ini1ne.BITSHIFT[Inl1ne,BITAND[byte, 300B], -6]]]; 
Stream.PutChar[octalStream. NibbleToChar[Inl1ne.BITSHIFT[Inl1ne.BITAND[byte, 0708], -3]]]; 
Stream.PutChar[octalStream, NibbleToChar[Inl1ne.BITAND[byte, 007B]]]; 

END; — PutByteOctal 
wordCount: LONG INTEGER <- 0; 
wordString: LONG STRING * [20]; 
blnaryStream. octalStream: Stream. Handle *- NIL; 

handle: Event.Handle <■ Event.Start1ngProcess["Octal Convert Tool is runn1ng"L]; 
binaryStream *• MStream.ReadOnly[data.binaryFileName, [NIL, NIL] ! 

MStream.Error => CONTINUE]; 

IF blnaryStream - NIL THEN [ 

CleanUp["Flie not ava11able!\n”L, handle]; 

RETURN}; 

octalStream «• GetWriteStream[data .octal FIleName , ~data .protectOctal , text]; 

IF octalStream = NIL THEN { 

Stream.Delete[b1naryStream]; 

C1eanUp["Output file Is protected!\n"L, handle]; 

RETURN}; 

PutBoth["Converting binary file ,M,,, L]; 

PutBoth[data.binaryFI1eName]; 

PutBoth[''”" to octal file ” W, 'L]; 

PutBoth[data.octal FileName]; 

PutBothf"'"* . ,."L]; 

Wr1teHeader[octalStream]; 

Stream.PutStr1ng[octalStream, ”\n-- "L]; 

String.AppendLongNumber[wordString, wordCount, 8]: 

Stream.PutString[octalStream, wordString]; 

Stream.PutChar[octalSt ream, Ascii.CR]; 

Stream.PutChar[octalStream, Ascii.CR]; 

DO 

ENABLE Stream.EndOfStream => EXIT; 

THROUGH [0. .8) DO 
THROUGH [0 .. 8) DO 

PutByteOctal[Stream.GetByte[binaryStream]]; 

Stream.PutChar[octalStream, ’.]; 

PutByteOctal[Stream,GetByte[binaryStream]]; 

Stream,PutChar[octalStream, Ascii ,SP]; 

Stream.PutChar[octa1St ream, Ascii,SP]; 

ENDLOOP; 

Stream.PutChar[octalStream, Ascii.CR]; 

ENDLOOP; 

wordCount <- wordCount + 64; 

Stream.PutString[octalStream, "\n\n~- "LJ; 
wordString.length «- 0; 

String.AppendLongNumber[wordString, wordCount, 8]; 

Stream.PutString[octalStream, wordString]; 

Stream.PutChar[octalStream, Ascii.CR]; 

Stream.PutChar[octalStream, Ascii.CR]; 

ENDLOOP; 

Stream.PutChar[octalStream, Ascii.CR]; 

Stream.PutChar[octal Stream, Ascii.CR]; 

Stream.Delete[binaryStream]; 

MStream.SetLength[octal Stream, MStream.Gettength[octal Stream]]; 

Stream,Delete[octal Stream]; 

CleanUp[".. Done!\n"L, handle]; 

END; — BinaryToOctal 

OctalToBInary: PROC * 

BEGIN 

blnaryStream, octalStream; Stream.Handle «■ NIL; 
byte: Envl ronment .Byte «■ 0; 
count: INTEGER <- 0; 
char: CHARACTER; 

handle: Event.Handle *• Event .StartingProcess["Octal Convert Tool Is runn1ng"L]; 
octalStream *• MStream.ReadOnly[data .octal FIleName , [NIL, NIL] ! 

MStream.Error => CONTINUE]; 

IF octalStream = NIL THEN { 

CleanUp[”Fi 1 e not available!\n ,, L, handle]; 

RETURN}; 

blnaryStream GetWriteStream[data.binaryFileName, ~data.protectBinary, binary]; 

IF blnaryStream = NIL THEN { 

Stream.Delete[octalStream]; 

CleanUp["Output file Is protected!\n”L, handle]; 

RETURN}; 

PutBoth["Converting octal file """L]; 

PutBoth[data.octalF11eName]; 

PutBoth[ ,,,M ' to binary file """L]; 

PutBoth[data.binaryFileName]; 

PutBoth[. ...”L]; 

DO 

BEGIN 

ENABLE Stream.EndOfStream => EXIT; 
char <- Stream,GetChar[octalStream] ; 

SELECT char FROM 
IN ['0,.'7] => { 

byte *■ byte * 8 + char - '0; 

IF (count «• count + 1) - 3 THEN { 

Stream,PutByte[binaryStream, byte]; 
byte *r 0; 
count «■ 0; 
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}: 

}: 

Ascii.CR. Ascii.SP, '. => NULL; 

*- => 

BEGIN 

IF Stream.GetChar[octalStream] = '- THEN 
UNTIL Stream.GetChar[octalStream] = Ascii.CR DO ENDLOOP 
ELSE 

GOTO badOctalChar; 

END; 

F.NDCASE => GOTO badOctalChar; 

EXITS badOctalChar => 

BEGIN 

Stream.Delete[octalStream]; 

MStream.SetLength[b1naryStream, 0] ; 

Stream.Delete[binaryStream]; 

CleanUp["Error: Illegal character encountered in octal filelW'L, handle]; 
RETURN; 

END; 

END; 

ENDLOOP; 

Stream.Delete[octalStream]; 

MJ»tream.SetLength[b1naryStream, MStream,GetLength[binaryStream]] ; 

Stream.Delete[b1naryStream]; 

CleanUp[".. DonelWL, handle]; 

END; -- OctalToBlnary 

GetWrlteStream: PROC [name: LONG STRING, overwrite: BOOLEAN, type: MFIle.Type] 
RETURNS [stream: Stream.Handle <• NIL] = 

BEGIN 

Stream *- MStream.ReadOnly[name, [NIL, NIL] ! MStream.Error => CONTINUE]; 

IF stream # NIL THEN { 

Stream.Delete[stream]; IF -overwrite THEN RETURN[NIL]}; 
stream «- MStream.WrlteOnly[name, [NIL, NIL], type]; 

END; -- GetWrlteStream 

WriteHeader: PROC [stream: Stream.Handle] = 

BEGIN 

dateAndTIme: LONG STRING <- [40]; 

Time.AppendCurrent[dateAndT1me, TRUE]; 

Stream.PutString[stream, File: tt L]; 

Stream.PutString[stream, data.octalFIleName]; 

Stream.PutStr1ng[stream, "\n-- From: "L]; 

Stream.PutStr1ng[stream. data.blnaryFIleName]; 

Stream.PutStr1ng[stream, "\n— Date: ”L]; 

Stream.PutStr1ng[stream, dateAndTIme]; 

Stream. PutSt r1ng[ st ream , l, \n\n"L] ; 

END; — WriteHeader 

Cleanup: PROC [reason: LONG STRING, event: Event.Handle] = 

BEGIN 

PutBoth[reason]; 

data. commandlsRunnlng +■ FALSE; 

Event,DoneW1thProcess[event]; 

END; — Cleanup 

PutBoth: PROC [s: LONG STRING] = { 

Put.Text[data.msgSW, $]; Put,Text[data.1ogSW, s]}; 


-- Mainline code 

Xn1t[]; 

END. . . 

LOG (Editor/Date/Comment): 

Trow 7-Sep-89 17:22:43 Adapted from HexConvertToolImp! to deal with files of XCharacters. 
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— TelegraphCodeConvertToolImp!.mesa 

— Trow:PARC:Xerox 9-Sep-89 16:03:23 

-- Copyright (c) 1989 by Xerox Corporation. All rights reserved. 

DIRECTORY 

Ascii USING [CR. SP], 

Environment USING [Byte], 

Event USING [DoneWIthProcess, Handle, StartlngProcess, toolWlndow], 

EventTypes USING [deactivate]. 

Exec USING [AddCommand, ExecProc, RemoveCommand], 

FormSW USING [AllocateltemDescrlptor, Booleanltem, CllentltemsProcType, 
Commandltem, ItemHandle, lineO, llnel, 11ne2, ProcType, Stringltem], 

Heap USING [Create, Delete], 

Inline USING [BITAND, BITSHIFT], 

MFile USING [Type], 

MStream USING [Error, GetLength, Readonly, SetLength, WrlteOnly], 

Process USING [Detach], 

Put USING [Line, Text], 

Runtime USING [GetBcdTime], 

Stream USING [Delete, EndOfStream, GetChar, GetByte, Handle, PutByte, PutChar, 
PutStrlng], 

String USING [AppendStrlng, AppendLongDecImal], 

Supervisor USING [AddDependency, AgentProcedure, CreateSubsystem, 
EnumeratlonAborted, RemoveDependency, SubsystemHandle], 

Time USING [Append, AppendCurrent, Unpack], 

Tool USING [Create, Destroy, MakeFIleSW, MakeFormSW, MakeMsgSW, MakeSWsProc, 
UnusedLogName], 

ToolWlndow USING [Activate, GetState, TransltionProcType], 

Window USING [GetChlld, GetParent, Handle, Stack, ValIdateTree]; 

TelegraphCodeConvertToolImp!: PROGRAM 

IMPORTS Event, Exec, FormSW, Heap, Inline, MStream, Process, Put, 

Runtime, Stream, String, Supervisor, Time, Tool, ToolWindow, Window 

BEGIN 


— Types 


Formlndex: TYPE = {protectBlnary, blnaryFIle, protectOctal, octalFIle, binaryToOctal, 
OCtalToBinary): 

Tool Data: TYPE = MACHINE DEPENDENT RECORD [ 
msgSW(O): Window.Hand!e «■ NIL, 
formSW(2): Window.Handle *• NIL, 
logSW(4): Window.Handle *■ NIL, 
protectBlnary(B): BOOLEAN <- TRUE, 
protect0ctal(7): BOOLEAN *■ TRUE, 
b1naryF11eName( 8): LONG STRING <- NIL, 
octalFlleName(lO): LONG STRING NIL, 
commandI$Runn1ng( 12): BOOLEAN «- FALSE]: 


— Constants 


agent: Supervisor.SubsystemHandle = Supervisor,CreateSubsystem[CheckDeactivate]: 


Globals 


data: LONG POINTER TO ToolData *■ NIL; 
wh: Window.Handle «* NIL; 
heap: UNCOUNTED ZONE <- NIL; 


Initialization 


Irilt: PROC = 

BEGIN 

Exec.AddCommand["TelegraphCodeConvertTool.-"L, MakeTool, NIL, Unload]; 

END: — Init 

MakeTool: Exec.ExecProc = 

BEGIN 

IF wh = NIL THEN 
BEGIN 

name: LONG STRING * [60]; 

String.AppendString[to: name, from : "TelegraphCode Convert Tool of "L]; 

Time .Append[s: name, unpacked: T1me.Unpack[ Q untime.Get8cdTime[]]]; 
name.length <■ name, length - 3; — lop the seconds 
wh <- Tool ,Create[name: name, makeSWsProc: MakeSWs, 

cllentTransItion: ClientTransition, cmSection: "TelegraphCodeConvertTool"L, 
tinyNamel: "TelegraphCode”L, t1nyName2: "Convert"L]; 

END 

ELSE IF ToolWindow.GetState[wh] = active THEN 
BEGIN 

newSibllng: W1ndow.Handle = Window.GetChild[W1ndow.GetParent[wh]]; 

IF wh # newSibllng THEN { 

Window.Stack[wh, newSibllng]; Window.Val1dateTree[wh]}; 

END 

ELSE 

ToolWindow.Activate[wh]; 
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END; — MakeTool 


Unload: Exec.ExecProc = 

BEGIN 

IF wh ¥ NIL THEN {Tool .Destroy[wh]; wh <- NIL}; 
Exec.RemoveCommand[h, "TelegraphCodeConvertTool.~"L]; 
END; — Unload 


- State change 


CheckDeactlvate: Supervisor.AgentProcedure = 

BEGIN 

IF event = EventTypes.deactivate AND wh ¥ NIL 
AND wh = eventData AND data.commandlsRunning THEN 
BEGIN 

Put.L1ne[data.msgSW. "Tool is busy!"L]; 

ERROR Supervisor.EnumerationAborted; 

END; 

END; — CheckDeactlvate 

CHentTransition: ToolWindow.TransItlonProcType = 

BEGIN 

SELECT TRUE FROM 
old = inactive => 

BEGIN 

IF heap * NIL THEN heap *■ Heap.Create[in1t1al: 1, increment; I]; 

IF data = NIL THEN data <- heap. NEW[ToolOata <- []]; 

END; 

new = Inactive => 

BEGIN 

Supervisor,RemoveDependency[cllent: agent, implementor: Event.toolWIndow]; 
IF data ¥ NIL THEN heap.FREE[Sdata]; 

IF heap # NIL THEN {Heap. Del ete[heap] ; heap <- NIL}; 

END; 

ENDCASE; 

END; — Cl lentTransition 


-- Tool window 


MakeSWs: Tool.MakeSWsProc * 

BEGIN 

logFileName: STRING = [50]; 

Tool,UnusedLogName[unused: logFileName, root: "TelegraphCodeConvertTool.log"L]; 
deita.msgSW <- Tool .MakeMsgSW[w1ndow: window]; 

data.formSW «- Tool .MakeFormSW[window: window, fcmProc: MakeForm]; 
deita.logSW *■ Tool .MakeFileSW[window: window, namy: logFileName]; 

Supervisor.AddDependency[client; agent, implementor: Event.toolWIndow]; 

END; -- MakeSWs 

MakpForm: FormSW.ClientltemsProcType = 

BEGIN 

OPEN FormSW; 

nXtems: CARDINAL = Formlndex.LAST.ORD + 1; 
items «- A1 locateItemDescr1ptor[nItems] ; 
items[FormIndex.protectBlnary.ORD] «- Booleanltem[ 

tag: "ProtectBinary"L, place: [0, lineO], switch: ©data.protectBinary]; 
items[FormIndex .binaryFile .ORD] <- Stringltem[ 

tag: "Binary File"L, place: [100, lineO], inHeap: TRUE, 
string: Ddata.binaryFileName]; 

1tems[FormIndex.protectOctal,ORD] <- Booleanltem[ 

tag: "ProtectOctal"L, place: [0, linel], switch: ©data.protectOctal]; 
items[FormIndex .octal File .ORD] <- Stringltem[ 

tag: "Octal F11e"L, place: [100, linel], inHeap; TRUE, 
string: Qdata.octalF11eName]; 

Items [Formlndex .blnaryToOctal .ORD] <- CommandItem[ 
tag: "Convert Binary To OctaT'L, place: [0, 11ne2], proc: Convert]; 
1tems[FormIndex.octalToB1nary.0R0] <* CommandItem[ 

tag: "Convert Octal To B1nary"L, place: [200, line2], proc: Convert]; 

RETURN[items: Items, freeDesc: TRUE]*, 

END; -- MakeForm 


-- Convert procs 


Convert: FormSW.ProcType = 

BEGIN 

IF data.commandlsRunning THEN 

Put.Line[data.msgSW, "Tool Is busy!"L] 

ELSE 

BEGIN 

convertProc: PROC *■ SELECT index FROM 

Formlndex.binaryToOctal.ORD => BlnaryToOctal, 
Formlndex.octalToBlnary.ORD -> OctalToBinary, 
ENDCASE = > ERROR; 
data .commandlsRunning *■ TRUE; 

Process.Detach[FORK convertProc[]]; 

END; 

END; -- Convert 

B •yToOctal: PROC = 

•IN 

’.ByteOctal: PROC [byte: Environment.Byte] = 


TelegraphCodeConvertToolImp!.mesa 


9-Sep-89 16:03:26 PDT 





BEGIN 

NlbbleToChar: PROC [n: CARDINAL] RETURNS [c: CHAR] = INLINE 
BEGIN 

c «• SELECT n FROM 

IN [0..7] => VAL[0RD['0] + n], 

ENDCASE => ERROR; 

END; — NlbbleToChar 

Stream.PutChar[octalStream, NibbleToChar[Inline.BITSHIFT[Inl1ne.8ITAND[byte, 300B], -6]]]; 
Stream.PutCharFoctalStream, NlbbleToChar[InlIne.BITSHIFT[In11ne.BITAND[byte, 070B], >3]]]; 
Stream.PutChar[octalStream, NlbbleToChar[IniIne,BITAND[byte, 0078]]]; 

END; -- PutByteOctal 
wordCount: LONG INTEGER <- 0; 
wordStrlng; LONG STRING <- [20]; 
blnaryStream, octalStream: Stream.Handle «■ NIL; 

handle: Event.Handle «■ Event.Start1ngProcess["TelegraphCode Convert Tool Is runn1ng"L]; 
blnaryStream *■ MStream,ReadOnly[data.blnaryFileName, [NIL. NIL] f 
MStream.Error => CONTINUE]; 

IF blnaryStream = NIL THEN { 

CleanUp["F1le not ava11able!\n"L, handle]; 

RETURN}; 

octalStream <- GetWr1teStream[data.octalF11eName , -data. protectOctal , text]; 

IF octalStream = NIL THEN { 

Stream.Delete[blnaryStream]; 

CleanUp["Output file Is protected!\n"L. handle]; 

RETURN}; 

PutBoth["Convert1ng binary file """L]; 

PutBoth[data.binaryFi1eName]; 

PutBoth[ M "" to octal file ,M, "L]; 

PutBoth[data.octalFIleName]; 

PutBoth[""" . ,."L]; 

Wr1teHeader[octalStream]; 

Stream.PutString[octalStream. "\n-- "L]; 

String.AppendLongDecimal[wordStr1ng. wordCount]; 

;St ream.PutStr1ng[octalStream, wordStrlng]; 

Stream,PutChar[octal Stream, Ascii.CR]; 

Stream.PutChar[octalStream, Asci1.CR]; 

DO 

ENABLE Stream.EndOfStream => EXIT; 

THROUGH [0..10) DO 
THROUGH [0 .. 10) DO 

PutByteOctal[Stream.GetByte[binaryStream]]; 

Stream.PutChar[octalStream, *.]; 

PutByteOctal[Stream.GetByte[b1naryStream]]; 

Stream.PutChar[octalStream, Ascii,SP]; 

Stream.PutChar[octal Stream, Ascii.SP]; 

ENDLOOP; 

Stream.PutChar[octalStream, Asci1.CR]; 

ENDLOOP; 

wordCount wordCount + 100; 

Stream.PutString[octalStream, "\n\n-- "L]; 
wordStrlng.length «■ 0 ; 

String.AppendLongDec1mal[wordStr1ng, wordCount]; 

Stream.PutString[octalStream, wordString]; 

Stream.PutChar[octalStream, Ascii.CR]; 

Stream.PutChar[octalStream, Ascii.CR]; 

ENDLOOP; 

Stream.PutChar[octalStream, Ascii.CR]; 

Stream.PutChar[octalStream, Ascii.CR]; 

Stream.Delete[binaryStream]; 

MStream.SetLength[octal Stream, MStream.GetLength[octal Stream]]; 

Stream.Delete[octalStream]; 

CleanUp[".. Done!\n"L, handle]; 

END; — BlnaryToOctal 

OctalToBlnary; PROC = 

BEGIN 

blnaryStream, octalStream; Stream .Handle +■ NIL; 
byte: Environment.Byte *• 0; 
count: INTEGER <- 0; 
char: CHARACTER; 

handle: Event.Handle «■ Event ,Stari;1ngProces$["TelagraphCode Convert Tool Is runn1ng"L]; 
octalStream *■ MStream.ReadOnly[data.octalFileName , [NIL, NIL] ! 

MStream.Error => CONTINUE]; 

IF octalStream => NIL THEN [ 

CleanUp['’File not ava11ab1e!\n"L, handle]; 

RETURN}; 

blnaryStream *• GetWriteStream[data.b1naryF11eName , -data .protectBi nary, binary]; 

IF blnaryStream - NIL THEN { 

Stream,Delete[octalStream]; 

C1eanUp[”0utput file is protected!\n’'L, handle]; 

RETURN}; 

PutBoth["Converting octal file n,, "L]; 

Put8oth[data.octalFileName] ; 

PutBoth[""" to binary file """L]; 

PutBoth[data.binaryFileName]; 

PutBoth[""" ... M L]; 

DO 

BEGIN 

ENABLE Stream.EndOfStream => EXIT; 
char *■ Stream.GetChar[octalStream] ; 

SELECT char FROM 
IN [*0. . ’7] => { 

byte «- byte * 8 + char - ’ 0 ; 

IF (count «- count + 1) a 3 THEN { 

Stream.PutByte[binaryStream, byte]; 
byte *• 0 ; 
count * 0; 
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}; 

}: 

Ascii.CR, Ascii.SP. => NULL; 

BEGIN 

IF Stream.GetChar[octalStream] = THEN 

UNTIL Stream.GetChar[octalStream] = Ascii.CR DO ENDLOOP 
ELSE 

GOTO badOctalChar; 

END; 

ENDCASE => GOTO badOctalChar; 

EXITS badOctalChar => 

BEGIN 

Stream.De1ete[octa1Stream]; 

MStream.SetLength[b1nary$tream, 0]; 

Stream.Delete[binaryStream]; 

CleanUppError: Illegal character encountered In octal f11e!\n"L, handle]; 
RETURN; 

END; 

END; 

ENDLOOP; 

Stream.Delete[octalStream]; 

MStream.SetLength[binaryStream. MStrearn,GetLength[binaryStream]]; 

St ream. Delete[bInarySt ream]; 

CleanUpp.. Done!\n"L, handle]; 

END; — OctalToBlnary 

GotWrlteStream: PROC [name; LONG STRING, overwrite: BOOLEAN, type: MFIle.Type] 
RETURNS [stream: Stream .Hand! e <- NIL] = 

BEGIN 

Stream *■ MStream.ReadOnly[ name , [NIL, NIL] ! MStream. Error => CONTINUE]; 

IF stream 0 NIL THEN { 

Stream.Delete[stream]; IF -overwrite THEN RETURN[NIL]} ; 
stream *■ MStream.WriteOnly[name, [NIL, NIL], type]; 

END; • GetWrlteStream 

WriteHeader: PROC [stream; Stream.Handle] = 

BEGIN 

dateAndTIme: LONG STRING <- [40]; 

TIme.AppendCurrent[dateAndTime, TRUE]; 

Stream,PutString[stream, "— File; ”L]; 

Stream.PutStr1ng[stream, data.octal FIleName]; 

Stream.PutStr1ng[stream, "\n-- From: "L]; 

Stream.PutString[stream. data.binaryF11eName]; 

Stream.PutStr1ng[stream, "\n-- Date: "Lj; 

Stream.PutString[stream, dateAndTime]; 

Stream.PutStr1ng[stream, "\n\n"L]; 

END; -- WriteHeader 

Cleanup: PROC [reason: LONG STRING, event: Event.Handle] = 

BEGIN 

PutBoth[reason]; 

data.commandlsRunnlng *■ FALSE; 

Event.DoneWIthProcess[event]; 

END; — Cleanup 

PutBoth: PROC [s: LONG STRING] * { 

Put,Text[data.msgSW, s]; Put.Text[data.logSW, s]}; 


-- Malnl1ne code 


Init[]; 

END. . . 

LOG (Editor/Date/Comment): 

Trow 7-Sep-89 22:43:58 Adapted from HexConvertToolImpl to deal with files of XCharacters arranged in telegraph code order. 
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—- File: CvXIit.mesa 
— Trow 7~Sep-89 16:32:38 


Last Revised by: Erickson 24-Nov-16 53:30 

—- Owner: Workstation Applications - Foreign Conversion Team 

— Copyright (c) 1984, 1985,1986,1987, 1989 by Xerox Corporation All rights reserved 

DIRECTORY 

Converter 

USING [ConvertProc, CvData, DestroyProc, DependentOptionProc, MenultemProc] 
NSFile 

USING [Reference], 

Window 

USING [Handle], 

XChar 

USING [Character], 

XString 

USING [Reader, ReaderBody, Writer]; 


< < 


— OVERVIEW: 

Private definitions interface for the ascii conversion. 


> > 

CvXlit: DEFINITIONS = 
BEGIN 


— CONSTANTS 


modern: CARDINAL = 0; 
classic: CARDINAL = 1; 

twelve: CARDINAL = 0; 
eightteen: CARDINAL = 1; 
twentyFour: CARDINAL = 2; 

unlimited: CARDINAL = 0; 
limited: CARDINAL - 1; 

dfltFont: CARDINAL = classic; 
dfltFontSize: CARDINAL = twelve; 
dfltTrailing: BOOLEAN = FALSE; 
dfltLineLen: CARDINAL = unlimited; 
dfltChars: CARDINAL = 80; 
dfltWordWrap: BOOLEAN = TRUE; 

leadingMargin: CARDINAL = 2; 
points8etweenltems: CARDINAL = 10; 


— TYPES 


AsdiToVPTable: TYPE = LONG POINTER TO ARRAY CHARACTER OF XChar.Character; 

VPToAsciiTable: TYPE = LONG POINTER TO ARRAY [0..256) OF LONG POINTER TO ARRAY [0..256) OF CHARACTER; 

Boolean: TYPE = MACHINE DEPENDENT RECORD! 
zeros(0:0..14): [0..7777B),value(0:15. 15): BpOLEAN]; 

Common: TYPE = LONG POINTER TO CommonData; 

CommonData: TYPE = RECORD [ 
cvData: Converter.CvData, 
options: BOOLEAN, 
window: Window.Handle, 
owner: Owners, 
ref: NSFile.Reference, 
f: CommonObj, 
textRb: FiledXStrings, 
text : EncodedText, 
z: UNCOUNTED ZONE]; 

The same data strcture is used by all the client formwindows/details sections. 

> > 

Filed: TYPE = LONG POINTER TO CommonObj; 

CommonObj: TYPE = MACHINE DEPENDENT RECORD { 
font; CARDINAL dfltFont, 
fontSize: CARDINAL dfltFontSize, 
ignoreTrailing: Boolean [0, dfltTrailing], 
lineLen: CARDINALdfltLineLen, 
charsSuffix: CARDINAL«-dfltChars, 
wordwrap: Boolean [0, dfltWordWrap] 

]; 


This data structure is the filed data object, along with the various strings/text items that come from the formwindows 

> > 

EncodedText: TYPE = ARRAY TextIDs OF LONG STRING; 

Use long strings internally, since they are better suited to ASCI* text. 

> > 
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FiledXStrings: TYPE = ARRAYTextIDs OF XString.ReaderBody; 

< < 

Filed strings are kept here. 

> > 

Owners: TYPE = {AtoVsrc, AtoVdst, VtoAdst, backstop}; 

TextIDs: TYPE = { 
paraEndsWith, 
atovReplaceUnknown, 
endLine, 
encIPara, 

vtoaReplaceUnknown, 

avTableName, 

vaTableName 

}; 


— SIGNALS 


Problem: SIGNAL [err: ProblemType]; 

ProblemType: TYPE = {obsoleteDataFile, fatalError, doDflts, other}; 


— PROCEDURES 


AsciiToVP: Converter. ConvertProc; 

< < == PROCEDURE [source: NSFile.Handle, cvData; Converter.CvData,session: NSFile.Session,srclnstance: LONG POINTER NIL, dstlnstance- 
LONG POINTER *- NIL, background: BOOLEAN *— FALSE] RETURNS [dest: NSFile.Handle«- LOOPHOLEIO]]; 

Exported by CvXIitToVPImpl. 

> > 


AsciiToVPSrcOps: Converter.DependentOptionProc, 

< < — PROCEDURE [options: BOOLEAN *-TRUE, cvData; Converter.CvData, which: Converter.FormatToUse, srcFormat: XString.Reader, destFormat: 
XString.Reader, window: Window.Handle, oldlnstance; LONG POINTERNIL] RETURNS [menultemProc: Converter.MenultemProc, destroy: 
Converter.DestroyProc, instance: LONG POINTER]; 

Exported by CvXIitToVPImpl. 

> > 


Asci iToVPDstOps: Converte r. Depe ndentOptionProc; 

< < = PROCEDURE [options: BOOLEAN«-TRUE, cvData: Converter.CvData, which: Converter.FormatToUse, srcFormat: XString.Reader, destFormat: 
XString.Reader, window: Window.Handle, oldlnstance: LONG POINTER«—NIL] RETURNS [menultemProc: Converter.MenultemProc, destroy: 
Converter.DestroyProc, instance: LONG POINTER]; 

Exported by CvXIitToVPImpl. 


CommonMenu: Converter.MenultemProc; 

<< = PROCEDURE [instance: LONG POINTER, menultem: PropertySheet.MenultemType] RETURNS [ok: BOOLEAN *- TRUE]; 
Exported by CvXIitFWImpl. 


CreateCommon: PROC [cvData: Converter.CvData, options: BOOLEAN, window: Window.Handle, owner; Owners] RETURNS [my: Common]; —! 
NSFile.Error 

< < 

Exported by CvXIitDatalmpl. 

> > 


CreateFW: PROC [my; Common, window: Window.Handle, owner: Owners}; 
Exported by CvXUtFWImpi. 


DataFromWindow: PROC [w: Window.Handle] RETURNS [my: Common]; 

< < 

Exported by CvXIitMainlmpI 


DataToWindow: PROC [my; Common, w: Window.Handle]; 

< < 

Exported by CvXIitMainlmpI 

> > 


DestroyCommon: Converter.DestroyProc; 

< < = PROCEDURE [instance: LONG POINTER]; 

Exported by CvXIitDatalmpl. 

> > 

GetAVTable: PROC RETURNS [avTable: AsciiToVPTable]; 
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< < 

Exported byCvXIitToVPImpl. 
> > 


GetPreMargin: PROC [item: MessageKey] RETURNS [leads: CARDINAL]; 

< < 

Exported by CvXIitMainlmpl. 

> > 


GetMessage: PROC [msg: MessageKey] RETURNS [msgRb: XString.ReaderBody]; 

< < 

Exported by CvXIitMsgFilelmpl. 

> > 


GetVATable: PROC RETURNS [vaTable: VPToAsciiTable]; 

< < 

Exported by CvXIitFromVPImpl. 

> :> 


InitFiledData: PROC [my: Common]; — ! NSFile.Error 

< < 

Create and initialize clientfile. Exported byCvXIitDatalmpl. 

> > 


LoadFiledData: PROC [my: Common]; — ! NSFile.Error, Problem 

< < 

Read filed data. Exported by CvXIitDatalmpl. 


Parseltem: PROC [my: Common, r: XString. Reader, item: MessageKey, buf: XString.Writer 4 - NIL] RETURNS [ok: BOOLEAN, Is: LONG STRING]; 

Exported by CvXIitParselmpl. If ok is FALSE, error during parse. Is is NIL if item has null text, buf is a temporary buffer that will 
be created and destroyed each time the proc is called if defaulted, otherwise it will just be used. 


StoreFiledData: PROC [my: Common]; — I NSFile.Error 

Write filed data. Exported by CvXIitDatalmpl. 

> > 


VPToA^scii: Converter.ConvertProc; 

<< = : PROCEDURE [source: NSFile.Handle, cvData: Converter.CvData, session: NSFile,Session, srclnstance: LONG POINTER 4 - NIL, dstlnstance - 
LONG POINTER 4- NIL, background: BOOLEAN 4- FALSE] RETURNS [dest: NSFile.Handle 4 - LOOPHOLE[0]j; 

Exported by CvXIitFromVPImpl. 


VPToAsciiDstOps: Converter.DependentOptionProc; 

< < = PROCEDURE [options: BOOLEAN 4- TRUE, cvData: Converter.CvData, which: Converter.FormatToUse, srcFormat; XString.Reader, destFormat: 
XString.Reader, window: Window.Handle, oldfnstance: LONG POINTER 4— NIL] RETURNS [menultemProc: Converter.MenultemProc, destroy: 
Converter.DestroyProc, instance: LONG POINTER]; 

Exported by CvXIitFromVPImpl. 


— MESSAGES 


MessageKey: TYPE = { 
ascii Doc, 
paraEndsWith, 
fontSize, 
fontSizeChoices, 
font, 

fontChoices, 

ignoreTrailing, 

lineLen, 

lineLenChoices, 

charsSuffix, 

wordwrap, 

endLine, 

endPara, 

replaceUnknown, 

transliterationTable, 

sparePI, 

spareP2, 

spareP3, 

spareP4, 

spareP5, 

lastPsheetltem, 

left, 

right, 

c r. 

If, 

nl, 

ff, 

tab, 
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createError, 
notPF, 
paginating, 
skippedTableData, 
dfltAVEndParagraph, 
dfltAVReplaceCha racter, 
prefix, 
doneFailed, 
backstop, 
metaError, 
charsOutOf Bounds, 
fatalError, 
extraErrO, 
extraErrl, 
dfltVAEndLine, 
dfltVAEndParagraph, 
dfltVAReplaceCharacter 
}; 


ENI3. 

LOG 

5-Dec-B4 15:01:26 - MSchneider.pa - CREATED 
19-Dec-84 15:31:39- MSchneider- update to 8WS4.0 

16-Apr-85 10:40:52 - MSchneider - added some comments and owner statement 
28-May-85 9:23:59- M5chneider - took out messages now in common interface 
26-Feb-87 16:17:12 - Caro - Added paginating and spares 
18-Mar-87 14:02:39 - Caro - Completely rewritten for Enhancements I 
24-Nov-87 16:51:13 - Erickson - added aToVDfltMeta to change A to V paraEndsWith default 
from <CR><LF> to <CR> 
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— File: CvXIitDatalmpl.mesa 

— Trow 31-Aug-89 15:17:25 

— Last Revised by: Erickson 24-Nov-87 16:54:21 

— Owner: Workstation Applications - Foreign Conversion Team 

— Copyright (c) 1987, 1989 by Xerox Corporation. All rights reserved. 

DIRECTORY 

Courier 

USING [Description, DeserializeParameters, Error, Free, 

Parameters, SerializeParametersl, 

Converter 

USING [CreateClientFile, CvData, DestroyProc, FindClientFile], 

ConverterMsg 

USING [Get, kvpDocumentJ, 

CvXlit 

USING [Common, CommonData, CommonObj, 

GetMessage, Owners, Problem, TextlDsl, 

Environment 

USING [bytesPerPage], 

Heap 

USING [Create, Delete], 

NSFile 

USING [Delete, Error, Handle, nullReference, OpenByReference], 

NSFileStream 

USING [Create, GetLength, Handle, SetLength], 

Stream 

USING [Delete, InvalidOperation], 

Window 

USING [Handle], 

XString 

USING [CopyToNewReaderBody, DescribeReaderBody, FromSTRING, nullReaderBody, ReaderBody]; 


— OVERVIEW: 

Data and filed data procedures 


CvXIitDatalmpI: PROGRAM 
IMPORTS 

Converter, ConverterMsg, Courier, CvXlit, Heap, 
NSFile, NSFileStream, Stream, XString 
EXPORTS 
CvXlit = 

BEGIN 


— CONSTANTS 


keyBits: Key = 2707974433; — I* never change thisvaluel */ 
emptyRb: XString.ReaderBody = XString.FromSTRING]""LJ; 

currentVersion: Version = 4; —/* change this value if you alter the filed data format */ 


— History of Versions (update each time version number changes) 

— 18-Mar-87 11:48:29 - 1 - First version 

— 2-Mar-89 13:42:14- 2 - Xlit version 

— 29-Aug-89 21:03:36- 3 - Xlit version 

— 31 -Aug-89 12:01:31 - 4 - Xlit version 


— TYPES 


Key; TYPE = LONG CARDINAL; 
Version: TYPE = INTEGER; 


— PUBLIC PROCEDURES 


CreateCommon: PUBLIC PROC IcvData: Converter.CvData, options: BOOLEAN, window: Window.Handle, owner: CvXIit.Owners] RETURNS [my: 
CvXIitCommon] = { 

z: UNCOUNTED ZONE <- Heap,Create[initial: 16, increment: 28]; 

my *-z.NEW[CvXlit.CommonData <- [ 
cvData: cvData, 
options: options, 
window: window, 
owner: owner, 
ref: NSFile.nullReference, 
textRb: ALUXString.nullReaderBody], 
text: ALL[NIL], 

z: zll; 

—/* find client file *1 
BEGIN 

ENABLE UNWIND = > Heap.Delete[z]; 
prefix: XString.ReaderBody«- CvXlit.GetMessage[prefix]; 
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sic: XString.ReaderBody <— CvXlit.GetMessage[asdiDoc]; 

dst: XString.ReaderBody «-ConverterMsg.Get[ConverterMsg,kvpDocument]; 

my. ref «- Converter. FindCiie ntFilel 
cvData: cvData, 
srcFormat: @src, 
destFormat: @d$t, 
prefix: @p refix]; 

IF my.ref ~ NSFile.nulfReference THEN 

{ 

—/* file never created, so initialize */ 
lnitFiledData[my]; — I* fills in my.ref */ 

}; 


—/* read data */ 

BEGIN 

ENABLE CvXIitProblem => 

{ 

file: NSFile.Handle<s-NSFile.OpenByReference[my.ref]; 

avPara: XString. ReaderBodyCvXlit.GetMessage[dfltAVEndParagraph]; 

avChar: XString.ReaderBody <-CvXlit.GetMessage[dfltAVReplaceCharacter], 

valine: XString.ReaderBody <— CvXlit.GetMessage(dfltVAEndLinej; 

vaPara: XString.ReaderBody *-CvXlit.GetMessage[dfltVAEndParag raph]; 

vaChar: XString.ReaderBody<-CvXlitGetMessage[dfltVAReplaceCharacter], 

--/* get rid of old file, reinitialize *7 

NSFile.Delete[file]; 

lnitFiledData[my]; 

my.textRb [ 

paraEndsWith: avPara, 
atovReplaceUnknown: avChar, 
endLine: vaLine, 
endPara: vaPara, 
vtoaReplaceUnknown: vaChar, 
avTableName: emptyRb, 
vaTableName: emptyRb]; 

CONTINUE; 

}; 


LoadFiledDatalmy]; 

END; 

END; 


DestroyCommon: PUBLIC Converter.DestroyProc — { 
< < = PROCEDURE [instance: LONG POINTER]; 

> > 

my: CvXIit.Common instance; 
z: UNCOUNTED ZONE; 

IF my = NIL THEN RETURN; 
z «— my.z; 

Heap.Delete[z]; 

}; 


InitFiledData: PUBLIC PROC[my: CvXIit.Common] = { 
myObj: CvXIit.CommonData; 

avPara: XString.ReaderBody <—CvXlit.GetMessage[dfltAVEndParagraph]; 
avChar: XString .ReaderBody CvXlit.GetMessage[df ItAVReplaceCharacter]; 
vaLine: XString.ReaderBody *— CvXlit.GetMessage[dfltVAEndLine]; 
vaPara: XString.ReaderBody CvXlit.GetMessage]dfltVAEndParagraph]; 
vaChar: XString.ReaderBody «~CvXlit.GetMessage[dfltVARepiaceCharacter); 

—/* make dummy filed data */ 
myObj.textRb [ 

paraEndsWith: avPara, 
atovReplaceUnknown: avChar, 
endLine: vaLine, 
endPara: vaPara, 
vtoaReplaceUnknown: vaChar, 
avTableName: emptyRb, 
vaTableName: emptyRb]; 

--/* create client file */ 

BEGIN 

prefix: XString.ReaderBody CvXIit.GetMessagelprefix]; 

src: XString.ReaderBody <-CvXlit.GetMessage[asciiDoc]; 

dst: XString.ReaderBodyConverterMsg.GetlConverterMsg.kvpDocument]; 

my.ref «- Converter.CreateCiientFile] 
cvData: my.cvData, 
srcFormat: @src, 
destFormat: @dst, 
prefix: @prefix]; 

END; 

myObj.ref my.ref; 
myObj.z«- my.z; 

rnyObj.owner backstop; —/* let Store FiledData know we are initializing */ 
—/‘store*/ 

StoreFiledData[@myObj]; 


LoadFiledData: PUBLIC PROC (my: CvXIit.Common] = { 
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sh: NSFileStream.Handle [NIL]; 
file: NSFile.Handle; 
parms; Courier. Para meters; 
tz: UNCOUNTED ZONE NIL; 

—/* read filed data */ 

BEGIN 

ENABLE 

{ 

Courier.Error, Stream.InvalidOperation = > NSFile.Error[[access[file Damaged]]]; 
UNWIND = > 

{ 

IF sh # NSFileStream.HandlelNIL] THEN Stream.Deletefsh}; 

IFtz# NIL THEN Heap.Delete[tz]; 

}; 

}; 


—/* open data file */ 

file«- NSFile.OpenByReference[my,refj; 

-—/* open read stream on data file */ 

sh <- NSFileStream,Create[file: file, closeOnDelete: TRUE]; 

-—/* create temporary zone for disjoint data *7 

tz *— Heap.Create[(NSFileStream.GetLength[sh]/£nvironment.bytesPerPage) + 21; 


■—/* read key */ 

BEGIN 
key: Key; 

parms <-[location: @key, description; DescribeKey]; 
Courier.DeserializeParametersIparms, sh,tz]; 

IF key # keyBits THEN 

{ 

—/* quit */ 

Courier.Free[parms, tz]; 

Stream.Delete[sh]; 
sh <- [NILJ; 

SIGNAL CvXlit.Problem[obsoleteDataFile]; 

}; 

Courier.Free(parms, tz]; 

END; 

—/* read version */ 

BEGIN 

ver: Version; 

parms «-[location: @ver, description: DescribeVersion]; 
Courier.DeserializeParameters[parms, sh, tz]; 

IF ver # currentVersion THEN 

( 

—/* quit *7 
Courier.Freetparms, tz]; 

Stream. Delete[sh]; 
sh «— [NIL]; 

SIGNALCvXlit.Problem[obsoleteDataFile]; 

}; 

Courier.Freetparms, tz]; 

END; 

— I* read commonObj */ 

parms [location: @my.f, description: DescribeCommonObj]; 
Courier.DeserializeParametersIparms, sh, tz]; 

—/* read paraEndsWith */ 

BEGIN 

rb: XString.ReaderBody; 

parms*- [location: @rb,description: XString.DescribeReaderBody]; 
Courier.DeserializeParametersIparms, sh, tz]; 

my.textRbfparaEndsWith]«— XString.CopyToNewReaderBody[@rb, my.z]; 
Courier.Freetparms, tz]; 

END; 

—/* read atovReplaceUnknown */ 

BEGIN 

rb: XString.ReaderBody; 

parms*- [location: @rb,description: XString.DescribeReaderBodyl; 
Courier.DeserializeParametersIparms, sh,tz); 

rny.textRb[atovReplaceUnknown] «-XString.CopyToNewReader8ody[@rb, my.z]; 
Courier.Free[parms, tz]; 

BIND; 

—/* read endLine *7 
BEGIN 

rb: XString.ReaderBody; 

parms*- [location: @rb, description: XString.DescribeReaderBody]; 
Courier.DeserializeParametersIparms, sh, tz]; 
my.textRb[endLine] <—XString.CopyToNewReaderBody[@rb, my.z]; 
Courier.Freetparms, tz]; 
e:nd; 

---/* read endPara */ 

BEGIN 

rb: XString.ReaderBody; 

parms*~ [location: @rb,description: XString.DescribeReaderBody]; 
Courier.DeserializeParametersIparms, sh, tz]; 
rny.textRb[endPara] XString.CopyToNewReaderBody[@rb, my.z]; 
Courier.Freetparms, tz]; 

BIND; 
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—/* read vtoaReplaceUnknown *7 
8 EG IN 

rb: XString.ReaderBody; 

parms«- {location: @rb, description: XString.DescribeReaderBody]; 

Courier.DeserializeParametersfparms, sh, tzj; 

my.textRb[vtoaReplaceUnknown] <—XString.CopyToNewReaderBody[@rb, my.z]; 
Courier.Free[parms, tzj; 

END; 

■—/* read avTabieName */ 

BEGIN 

rb: XString.ReaderBody; 

parms [location: @rb, description: XString.DescribeReaderBody]; 
Courier.DeserializeParametersfparms, sh, tzj; 

rny.textRb[avTableName|<—XString.CopyToNewReaderBody[@rb, my.zj; 
Courier.Freefparms, tz]; 

END; 

—/* read vaTableName */ 

BEGIN 

rb: XString.ReaderBody; 

pawns [location: @rb, description: XString.DescribeReaderBody]; 
Courier.DeserializeParameters[parms, sh, tz]; 

rny.textRb[vaTableName] <-XString.CopyToNewReaderBody{@rb, my.z]; 
Courier.Free[parms, tz]; 

END; 

END; 


—/* clean up *1 
Stream. Deletelsh]; 
Heap.Delete[tz]; 

}; — toadFiledData 


--StoreFiledData 

— * This is tricky, since common data is used. This routine could be called 

— * three different times, with different subsets of data, but the whole 

— * file must be written each time. 


StoreFiledData: PUBLIC PROC[my: CvXIit.Common] = { 
dataFile: NSFile.Handle; 
sh: NSFileStream.Handle; 
perms; Courier.Parameters; 
tmpMy: CvXIit.CommonData; 

—/* fill out dummy */ 
tmpMy «- my f ; 

IF my.owner # backstop THEN 
LoadFiledData[@tmpMy}; 

—/* open data file *7 

dataFileNSFile.OpenByReference{my.ref]; 

—/* open stream on file */ 

sh<- NSFileStream.Create[file: dataFile, closeOnDelete: TRUE]; 
NSFileStream.SetlengthffileStream: sh, lengthlnBytes: 0]; 

—/* write data */ 

BEGIN 

ENABLE 

{ 

Courier.Error, Stream.InvaiidOperation = > NSFile,Error[[access[fileDamaged]]j; 
UNWIND = > Stream.Deletelsh]; 

}; 


--/* write key */ 

BEGIN 

key: Key«-keyBits; 

parms«- [location: @key, description: DescribeKey]; 
Courier.SerializeParameters[parms, sh]; 

END; 

—/* write version */ 

BEGIN 

ver: Version currentVersion; 

pawns*-[location: @ver, description: DescribeVersion]; 
Courier.SerializeParameterstparms, sh]; 

END; 

— I* update portions of data record *7 
SELECT my.owner FROM 
AtoVsrc = > 

{ 

tmpMy.textRb[paraEndsWith]*- my.textRb[paraEndsWithj; 

}; 

AtoVdst = > 

{ 

tmpMy.f.font*- my.f.font; 
tmpMy.f.fontSize «- my.f.fontSize; 

tmpMy.textRb[atovReplaceUnknown] <— my.textRb[atovReplaceUnknown]; 
tmpMy.f.ignoreTrailing my.f.ignoreTrailing; 
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tmpMy.textRb[avTableName] *- my.textRb(avTableName]; 

h 

VtoAdst = > 

{ 

tmpMy.f.lineLen *- my.f.lineLen; 
tmpMy.f.charsSuffix my.f.charsSuffix; 
tmpMy.f. word Wrap <— my.f.wordWrap; 
tmpMy.textRbiendLine] my.textRb [endLine]; 
tmpMy.textRbjendPara] my,textRb[endParaj; 

tmpMy.textRb[vtoaReplaceUnknown] <— my,textRb[vtoaReplaceUnknown]; 
tmpMy.textRb[vaTableName]«- my.textRb[vaTableName]; 

}; 

ENDCASE; 

—/* write filed data record */ 

parms«- [location; @tmpMy.f, description; DescribeCommonObj], 

Courier.SerializeParametersjparms, sh]; 

—/* write paraEndsWith string */ 

parms <- [location; @tmpMy.textRb[paraEndsWith], description; XString.DescribeReaderBody]; 
Courier.SerializeParameters[parms, sh|; 

— J* write atovReplaceUnknown string */ 

parms «s- [location: @tmpMy.textRb[atovReplaceUnknown], description: XString.DescribeReaderBody]; 
Courier.SerializeParameters[parms, sh]; 

—/* write endLine string */ 

parms*- [location; @tmpMy.textRb[endLine], description: XString.DescribeReaderBody]; 
Courier.$erializeParameters[parms, sh]; 

—/* write endPara string */ 

parms[location; @tmpMy.textRb[endPara], description: XString.DescribeReaderBody]; 
Courier.SeriaiizeParameters[parms, sh]; 

—/* write vtoaReplaceUnknown string */ 

parms <- [location: @tmpMy.textRb[vtoaReplaceUnknown), description: XString.DescribeReaderBody]; 
Courier.SerializeParametersiparms, sh]; 

—/* write avTableName string */ 

parms*- [location: @tmpMy.textRb[avTableName], description: XString.DescribeReaderBody]; 
Courier.SerializeParametersIparms, sh]; 

—I* write vaTableName string *! 

parms <- [location: @tmpMy.textRb[vaTableName] ( description: XString.DescribeReaderBody]; 
Courier.SerializeParametersiparms, sh]; 

END; 

Stream .Delete[sh]; 

}; 


— PROCEDURES 


DescribeKey: Courier.Description = { 

p: LONG POINTER TO Key = notes.noteSize[SIZE[Key]]; 
notes.noteLongCardinal[p]; 

}; 


Describe Version: Courier.Description = { 

p: LONG POINTER TO Version = notes.noteSize[SIZE[Version]]; 

}; 


DescribeCommonObj: Courier.Description = { 

p: LONG POINTER TO CvXIit.CommonObj = notes.noteSizel 
SIZEICvXI it.Com monO bj]]; 

}; 


END... 

LOG 

16--Mar-87 14:06:16 - Caro - Created 

24-Nov-87 16:55:56 - Erickson - Changed default setting of paraEndsWith 
to <CR> insteadof <CR><LF> 
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— File: CvXIitFromVPImpl.mesa 

— Trow 5-Sep-89 23:14:31 

— Last Revised by: Caro 16-Sep-87 12:21:45 

— Owner; Workstation Applications - Foreign Conversion Team 

— Copyright (c) 1987, 1989 by Xerox Corporation. All rights reserved. 

DIRECTORY 

Ascii 

USING [CR.FF, LF, SP, TAB], 

Backg ro undProcess 
USING [UserAbort], 

BWSZone 

USING (Permanent], 

Converter 

USING (ConvertProc, CvData, DependentOptionProc, DestroyProc, MenultemProc, PostMessage], 

ConverterMsg, 

CvXlit 

USING [Common, CommonMenu, CreateCommon.CreateFW, 

DestroyCommon, GetMessage, limited, MessageKey, Owners, 

Parseltem, Problem, unlimited], 

DocInterchangeDefs 

USING [Close, Doc, Enumerate, EnumProcsRecord, Error, NewParagraphProc, Open, OperiStatus, PFCProc, PageBreakProc, TextProc], 
DocInterchangePropsDefs 
USING [StreakSuccessionJ, 

Environment 

USING [wordsPerPage], 

NSFile 

USING [Attribute, Create, Delete, Error, GetReference, Handle, nullHandle, Session], 

NSFileStream 

USING (Create, Handle], 

Space 

USING (ScratchMap], 

StarFileTypes 
USING [text], 

Stream 

USING [PutChar, Delete], 

String 

USING [MakeString], 

TIP 

USING (UserAbort], 

XChar 

USING [Code, Set], 

XMessage 

USING [MsgKey], 

XString 

USING (InvalidEncoding, ReaderBody, Map, MapCharProc]; 


< <: 


— OVERVIEW: 

VP 1:o ASCII encoded Xlit conversion. 



CvXlitFromVPImpI: PROGRAM 
IMPORTS 

Backg roundProcess, BWSZone, Converter, ConverterMsg, CvXlit, 
DocInterchangeDefs, 

NSFile, NSFileStream, Space, Stream, String, TIP, XChar, XString 
EXPORTS 
CivXlit = 

BEGIN 


— CONSTANTS 


tablnterval: CARDINAL = 8; 

setMapSize: CARDINAL = SIZE[VPToAsciiSetMap]; 
charMapSize: CARDINAL = SIZE[VPToAsciiCharMap]; 


— TYPES 


—/* created from dest */ 


VAData; TYPE = LONG POINTER TO VADataObj; 

VADataObj: TYPE = RECORD [ 
source: NSFile.Handle, 
output: NSFileStream.Handle, 
cvData: Converter.CvData, 
session: NSFile.Session, 
dst: CvXIit.Common, 
background: BOOLEAN, 
doc: DocInterchangeDefs.Doc, 
putc: PutCProc, 
firstPara: BOOLEAN, 
line: LONG STRING, 
n: CARDINAL, 
pos: CARDINAL, 
max: CARDINAL, 
lastWhite: CARDINAL, 
wordwrap: BOOLEAN, 
after: CARDINAL, 


—/* line buffer */ 

—/* index of next char in line buffer*/ 
—/* current position on virtual line */ 
—/* last column in line */ 

—/* last white */ 

—/* number of eop strings to output *7 
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—/* for previous paragraph */ 
streak: DodnterchangePropsDefs.StreakSuccession, 
z: UNCOUNTED ZONE]; 

PutCProc: TYPE = PROC (va: VAData,c: CHARACTER]; 

VPToAsciiSetMap: TYPE = ARRAY [0..256) OF LONG POINTER TO VPToAsciiCharMap; 
VPToAsciiCharMap: TYPE = ARRAY (0..256) OF CHARACTER; 


— GLOBALS 


Global: TYPE = RECORD] 

defaultMap: LONG POINTER TO VPToAsciiSetMap, 
userMap: LONG POINTER TO VPToAsciiSetMap, 
gz: UNCOUNTED ZONE]; 

g: Global; 


— PUBLIC PROCEDURES 


VPToAscii: PUBLICConverter.ConvertProc — { 

< < = PROCEDURE {source: NSFile.Handle, cvData: Converter.CvData, session: NSFile.Session,srclnstance: LONG POINTER *- NIL, dstlnstance: 
LONG POINTER <- NIL, background: BOOLEAN FALSE] RETURNS [dest: NSFile.Handle <- LOOPHOLEIO]]; 

ENABLE CvXIit.Problem, NSFile.Error, XString.InvalidEncoding = > 

{ 

msgRb: XString.ReaderBody «- CvXlit.GetMessage[fatalErrorJ; 

Post|msgRb, cvData]; 

CONTINUE; 

V. 


IF source = NSFile.nullHandle THEN RETURN; 

dest VtoAlsource, cvData, session, srclnstance, dstlnstance, background]; 


This DependentOptionProc creates instance data with CreateCommon. The data is distinguished by the owner variable. The CommonObj within 
CvXIit.CommonData is the data structure written to the client file stored as the icon properties. Only those fields pertaining to the 
owner are used. 


> > 


VPToAsciiDstOps: PUBLIC Converter.DependentOptionProc = { 

< < = PROCEDURE {options: BOOLEAN TRUE, cvData: Converter.CvData, which: Converter.FormatToUse, srcFormat: XString.Reader, destFormat: 
XString.Reader, window: Window,Handle, oldlnstance: LONG POINTER <- NIL] RETURNS [menultemProc: Converter.MenultemProc, destroy: 
Converter.DestroyProc, instance: LONG POINTER]; 

> 15 - 

owner: CvXIit. Owners *-VtoAdst; 

menultemProc *- CvXIit.CommonMenu; 
destroy «— CvXIit.DestroyCommon; 

IF oldlnstance - NILTHEN 

instance «—CvXIit.CreateCommon[cvData,options, window,owner I NSFile.Error,CvXIit.Problem => {owner<-backstop; instance 
NIL; CONTINUE}] 

ELSE 

{ 

my: CvXIit.Common oldlnstance; 

my.window window; —/* AR 13535: update window handle */ 
instance my; 

1 ; 


—/* make formwindow */ 
CvXlit.CreateFW{instance, window, owner]; 

}<" 


GetVATable: PUBLIC PROC RETURNS [vaTable: LONG POINTER TO VPToAsciiSetMap] ={ 
R ETURN[g. userMap] ; 

}; 


— PROCEDURES 


VtoA; Converter.ConvertProc = { 
aborted: BOOLEAN <— FALSE; 
dataSkipped: BOOLEAN «— FALSE; 

attr: ARRAY [0..1) OF NSFile.Attribute <- UtypefStarFileTypes.text]]]; 
enumProcs: DocInterchangeDefs.EnumProcsRecord <-[ 
newParagraphProc: EndPrevAsciiPara, 
pageBreakProc: AddAsciiPage, 
textProc: AddAsciiText, 
pfcProc: AddAsciiPFC]; 

openStatus: DocInterchangeDefs.OpenStatus; 

vaData: VADataObj; — I* only works if Enumerate doesn't FORK */ 

dst: CvXIit.Common *— NIL; 
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-—/* initialize instance data *i 
li : dstlnstance = NIL THEN 
{ 

ENABLE NSFile.Error, CvXIit.Problem = > 

{ 

msgRb: XString.ReaderBody «-CvXlit.GetMessage[extraErrOl; —" Unrecoverable ASCII conversion error: damaged converter icon. 

Converter.PostMessage[ 
msg: @msgRb, 
cvData: cvData, 
cr: FALSE, 
clear: FALSE]; 

GOTO terminate; 

}; 

key: CvXIit.MessageKey <—CvXIit.MessageKey.FIRST; —/* dummy */ 

—/* we only care about dst */ 

dst«—CvXlit.CreateCommon[cvData, FALSE, NIL, VtoAdst]; 

dst.text[endLine] <h- CvXlit.Parseltem[ 
my: dst, 

r: @dsttextRb[endLine], 
item: key].Is; 

dst.text[endPara]CvXlit.Parseltem[ 
my: dst, 

r: @dst.textRb]endPara], 
item: key].Is; 

dst.text[vtoaReplaceUnknown]CvXIit.ParseltemI 
my: dst, 

r: @dst,textRb(vtoaReplaceUnknown], 
item: key].Is; 

EXITS terminate => RETURN; 

} 

ELSE 

{ 

dst«- dstlnstance; 

}; 


vaData*-1 

source: source, 
output: [NIL], 
cvData: cvData, 
session: session, 
dst: dst, 

background: background, 
doc: TRASH, 

putc: IF dst.f.lineLen = CvXIit.unlimited THEN UnbufferedPutC ELSE BufferedPutC, 

firstPara: TRUE, 

line: NIL, 

n: 0, 

pos: 0, 

max: 0, 

lastWhite: CARDINAL.LAST, 
wordwrap: dst.f.word Wrap, value, 
after: 0, 

streak: rightloLeft, 
z: dst.z]; 

If dst.f.lineLen = CvXIit.limited THEN 

{ 

—/* ASSERT: charsSuffix IN [10..256] */ 

—/* create line buffer */ 

vaData.line *- String.MakeString[z: vaData.z, maxlength: dst.f.charsSuffix]; 

vaData.Iine.length^-vaData.Iine.maxlength; 

vaData.max «-dst.f.charsSuffix - 1; 

IF dst.text[endLine] # NIL AND dst.text[endLine].length < vaData.max THEN 

{ 

—/* max column is limit less visible end-of-line characters */ 

FOR i: CARDINAL IN [0..dst.text[endLine].length) DO 
SELECTdst.text[endLine][i] FROM 

Ascii.CR, Ascii.LF, Ascii. FF => NULL; 

ENDCASE => vaData.max<-vaData.max - 1; 

ENDLOOP; 

}; 

}; 


BEGIN 

ENABLE 

{ 

NSFile.Error = > GOTO nsErr; 
DocInterchangeDefs.Error = > GOTO docErr; 
UNWIND => IF dstlnstance = NIL THEN 

{ 

CvXI it. Dest royCo mmon [dst] ; 
dst NIL; 

}; 

}; 


[vaData.doc, openStatus] DocInterchangeDefs.Openl 
docFileRef: NSFile.GetReferencefsource, vaData.session], 
session: vaData.session]; 

IF openStatus # ok THEN GOTO docErr; 

dest -t- NSFile.Create! 
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directory: NSFile.nuliHandle, 
attributes: DESCRIPTORlattr], 
session: session ! NSFile.Error = > { 

IF error = [space[mediumFull]] THEN 

Post[ConverterMsg.Get[ConverterMsg.koutOf Space], vaData.cvData] 

ELSE 

Post[CvXlit.GetMessage[createError], vaData.cvDataj; 

GOTO nsErr}]; 

vaData. output NSFileStream.Createf 
file: dest, 

closeOnDelete: FALSE, 
session: vaData.session]; 

dataSkipped DocInterchangeDefs.Enumeratel 
textContainer: [docfvaData.doc]], 
procs: @enumProcs, 
clientData: @vaData ! ABORTED = > { 
dataSkipped <h- TRUE; 
aborted *— TRUE; 

PostfConverterMsg.Get(ConverterMsg.kuserAbort], vaData.cvData]; 
CONTINUE}]; 

—/* AR 13705: flush any remaining text */ 

—/* ASSERT: n = 0 IF dst.f.lineLen # CvXIit.limited */ 

IF NOT aborted AND vaData.n > OTHEN 

{ 

RawPuts[@vaData, vaData.line, vaData.n]; 

—/* AR 14393: terminate last paragraph */ 

RawPuts(@vaData, vaData.dst.textfendPara]]; 

}; 


Stream.Delete[vaData.output! NSFile.Error = >{ 

IF error = (space[mediumFull]] THEN 

Post[ConverterMsg.Get(ConverterMsg.koutOfSpace], vaData.cvDataj 

ELSE 

Post[ConverterMsg.Get[ConverterMsg.kunknownProblem], vaData.cvDataj; 
NSFile.Delete[dest, vaData.session]; 
dest «- NSFile.nuliHandle; 

GOTO nsErr}]; 

IF dataSkipped THEN 

Post[ConverterMsg.Get[ConverterMsg.kdataSkipped], vaData.cvData]; 
DoclnterchangeDefs.CloseI@vaData.doc]; 

EXITS 

nsErr = > { 

IF vaData.doc # NILTHEN 

DocInterchangeDefs.Close[@vaData,doc ! DocInterchangeDefs.Error = > CONTINUE]}; 
docErr = > { 

key: XMessage.MsgKey <- 
SELECT openStatus FROM 

malFormed, incompatible => ConverterMsg.kincompatible, 
outOfDiskSpace, outOfVM => ConverterMsg.koutOfSpace, 

ENDCASE = > ConverterMsg.kcantOpen; 

Post]ConverterMsg.Get[key], vaData.cvData]; 

IF vaData.doc# NILTHEN 

DoclnterchangeDefs.Close{@vaData.doc ! DocInterchangeDefs.Error => CONTINUE]; 
dest <■- NSFile.nuliHandle}; 

END; 

IF vaData.line # NIL THEN vaData.z.FREE[@vaData.line]; 

—/* destroy instance data if created by this proc *! * 

IF d stir stance - NIL AND dst # NILTHEN CvXlit.DestroyCommon[dst], 


Post: PROC ImsgRb: XString.ReaderBody, cvData: Converter.CvData] = { 
Converter.PostMessag e| 
msg: @msgRb, 
cvData: cvData, 
cr: TRUE, 
clear: FALSE]; 

}; 


CheckAbort: PROC [background: BOOLEAN] RETURNS [yes: BOOLEAN] = INLINE { 
yes(background AND BackgroundProcess.UserAbortJ]) OR 
(NOT background AN D TIP.UserAbort[NIL]); 

}; 


—/* Enumeration Procs *7 

AddAsciiPage: DocInterchangeDefs.PageBreakProc - { 

< < = PROCEDURE [clientData: LONG POINTER, fontProps: DocInterchangePropsDefs.ReadonlyFontProps] RETURNS [stop: BOOL«— FALSE]; 

> > 

va: VAData ^-clientData; 

— form feed appended for a new page 
va.putclva. Ascii. FF]; 

}; 


EndPrevAsciiPara: DocInterchangeDefs.NewParagraphProc = { 

<< == PROCEDURE [clientData: LONG POINTER, fontProps: DocInterchangePropsDefs.ReadonlyFontProps, paraProps: 
DocinterchangePropsDefs.ReadonlyParaProps] RETURNS [stop: BOOL ♦—FALSE]; 
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va: VAData *- clientData; 


—/* ASSERT: n = 0 IF dst.f.lineLen # CvXIit.limited */ 

IF va.n > 0 THEN RawPuts[va, va.line, va.n]; —/* flush any pending text */ 

—/*a new para char means we terminate the previous ASCII paragraph*/ 

IF va.firstPara AND paraProps.basicProps.preLeading < paraProps.basicProps.lineHeight THEN 
va.firstPara FALSE 

ELSE 

{ 

—/* ceiling to next highest line */ 
newlines: CARDINAL «- 

(paraProps.bastcProps.preLeading + paraProps.basicProps.lineHeight - 1) 
paraProps.basicProps.lineHeight; 

IF NOT va.firstPara THEN 

{ 

—/* end previous paragraph */ 

RawPutsIva, va.dst.text[endPara]]; 

—/* append endLine strings for AFTER paragraph spacing */ 

THROUGH [1..va.after] DO 

RawPutsIva, va.dsttext(endLine)]; 

ENDLOOP; 

}; 


—/* thisnewPara character contains properties for the FOLLOWING * 

—/* paragraph, therefore output BEFORE line spacing first */ 
THROUGH (I..newlines} DO 

RawPutsIva, va.dst.text(endLinel); 

ENDLOOP: 
va.firstPara FALSE; 

}; 

va.n <—0; —/* reset line index */ 

va.pos 0; —/ * reset line position */ 

va.IastWhite CARDINAL.LAST; —/* reset last white */ 

—/* save AFTER line spacing *7 
va.after <- 

(para Props.basicProps.postLeading + paraProps.basicProps.lineHeight - 1)/ 
paraProps.basicProps.line Height; 
va.streak paraProps.basicProps.streakSuccession; 


AddAsciiPFC: DocInterchangeDefs.PFCProc — {}; 


AddAsciiText 

This procedure does the bulk of the text handling. Its main purpose is to translate VP characters into ASCII characters, according to 
the user's encoding selection. 



AddAsciiText: DocInterchangeDefs.TextProc = { 

< < = : PROCEDURE (clientData: LONG POINTER, fontProps; DoclnterchangePropsDefs.ReadonlyFontProps.text: XString.Reader, textEndContext: 
XString.Context] RETURNS [stop: BOOL *- FALSE]; 

> > 

va: VAData = clientData; 

—/* local procs */ 

XnToXO; XString.MapCharProc = { 
xset: [0..256) <— XChar.Set[c]; 
xcode: [0..256)XChar.Codelc]; 
mapc: CHARACTER; 
putc: PutCProc = va.putc; 

IF g.userMap[xset] # NIL THEN { 

mapc*- g.userMap{xset][xcode]; 

IF mapc #0C THEN { 

IF (mapc = 12C OR mapc = 15C)THEN{ 

Puts[va, va.dst.text[endLine]]; 

IF va.n > 0 THEN FlushLinelva]; 

} 

ELSE ( 

IF va.streak = rig htToLeft THEN { 

SELECT mapc FROM 
'( = > mapc <-'); 

') = > mapc^'(; 

'[ = > mapc*-']; 

'] = > mapc <r- 'I; 

'{ — > mapc*-'}; 

'} = > mapc '{; 

ENDCASE; 
putclva, mapc]; 

} 

ELSE 

putclva, mapc]; 

} 

> 

ELSE 

Putslva.va.dst.textlvtoaReplaceUnknown}}; 

} 

ELSE 

Puts[va, va.dst.textlvtoaReplaceUnknown]]; 
stop<- FALSE; 

}; 
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—/* begin code */ 

IF CheckAbortfva.background] THEN ERROR ABORTED; 
II *-XString.Map[r: text, proc: XnToXO]; 


—7* put procs */ 

UnfoufferedPutC: PutCProc = { 
Stream.PutChar[va.output, cj; 

}; 


BufferedPutC: PutCProc — { 

line: LONG STRING *~va.line; 

output: NSFileStream.Handle *~va.output; 

IF va.pos > va.max THEN 

{ 

IF va.wordwrap THEN 

{ 

offset: CARDINAL; 

—/* determine offset to new text */ 

IF va.IastWhite = CARDINAL. LAST THEN 

{ 

IFva.n > 0 THEN 

{ 

va.IastWhite*-va.n - 1; 
offset*- va.n; 

} 

ELSE 

offset*—va.IastWhite *-0; 

} 

ELSE 

offset va.IastWhite + 1; 

—/* flush to mark */ 

FOR i: CARDINAL IN [0..va.lastWhitel DO 
Stream.PutCharloutput, linefij]; 
ENDLOOP; 


—/* end line */ 

RawPuts[va, va.dst.text[endLine]]; 

—/* restore line *7 
FOR i: CARDINAL IN [offset..va.n) DO 
line(i—offset)«- line[i]; 

ENDLOOP; 

va.n va.n - offset; 

va.IastWhite *—CARDINAL.LAST; 

—/* reset pos */ 
va.pos *-0; 

FOR i: CARDINAL IN (0..va.n) DO 

va.pos *- IF linelil = Ascii.TAB THEN 

((va.pos / tablnterval) + 1) * tablnterval 
ELSE IF (c = Ascii.CR OR c = Ascii.LF) THEN 
va.pos 

ELSE 

va.pos + 1; 

ENDLOOP; 

} 

ELSE 

{ 

RawPutsfva, line, va.n]; 

—/* end line */ 

RawPuts(va, va.dst.text{endLine}] ; 
va.n *-0; 
va.pos *-0; 

}; 


IFva.n >= line.lengthTHEN 

{ 

RawPuts[va, line]; 
va.n <-va.pos *-0; 
va.IastWhite *-CARDINAL.LAST; 

}; 


—/* append character */ 
line]va.n] *—c; 

IFc = Ascii.SP THEN va.IastWhite*-va.n; 
va.pos *-IF c = Ascii.TAB THEN 

((va.pos/tablnterval) + 1) * tablnterval 
ELSE IF (c = Ascii.CR OR c = Ascii.LF) THEN 
va.pos 

ELSE 

va.pos 4-1; 
va.n *-va.n + 1; 


—/* put a string *t 
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Puts: PROC [va: VAData, s: LONG STRING] = { 
IFs = NIL THEN RETURN; 

IFs,length = OTHEN RETURN; 

FOR i: CARDINAL IN [0..s.length) DO 
va.putc[va, s(l]]; 

ENDLOOP; 


■—/* raw put string */ 

RawPuts; PROC [va: VAData, s: LONG STRING, limit: CARDINAL«-CARDINAL.LAST] = { 
IFs — NIL THEN RETURN; 

IFs.length = OTHEN RETURN; 

IF limit = CARDINAL.LAST THEN limit «-s.length; 

FOR i: CARDINAL IN [0..limit) DO 

Stream.PutChar(va,output, s[i]]; 

ENDLOOP; 


FlushLine: PROC [va: VAData] = { 
RawPuts[va, va.line, va.n]; 
va.n *-va.po$ «-0; 
va.IastWhite <- CARDINAL.LAST; 

); 


Zzlnit: PROC = { 

gz: UNCOUNTED ZONE = BWSZone.Permanent!]; 

—/* these Spaces should not be unmapped while this application is loaded */ 

g«-l 

defaultMap; Space.ScratchMap[(setMapSize + Environment.wordsPerPage-1) / Environment.wordsPerPage], 
userMap: Space.ScratchMap[(setMapSize + Environment.wordsPerPage-1) / Environment.wordsPerPage], 
gz: gz]; 

—/* initialize conversion maps *7 

FOR s: CARDINAL IN [0..256) DO 
g.defaultMap[s]NIL; 
g.userMapIs] *- NIL; 

ENDLOOP; 

g.defaultMap[0]<-Space,ScratchMap[(charMapSize 4- Environment.wordsPerPage-1) / Environment.wordsPerPage]; 
g.defaultMap[41B] «-Space.ScratchMap[(charMapSize -f Environment.wordsPerPage-1) / Environment.wordsPerPage]; 
g,defaultMap[357B] Space.ScratchMapKcharMapSize + Environment.wordsPerPage-1) / Environment.wordsPerPage]; 

g,userMap[0] *— Space.ScratchMap[(charMapSize + Environment.wordsPerPage-1) / Environment.wordsPerPage]; 
g.userMap[41B]Space.ScratchMap[(charMapSize + Environment.wordsPerPage-1) / Environment.wordsPerPage]; 
g.userMap[357B] «- Space.ScratchMap[(charMapSize + Environment.wordsPerPage-1) / Environment.wordsPerPage]; 

FOR c: CARDINAL IN [0..256) DO 
g ,defaultMap[0][c] <- VAL(c]; 
g.userMap[0][c] VAL[c]; 

g.defaultMap[41 B][c] <- VAL[0]; 
g.userMap[41B][c]VAL[0]; 
g.defaultMap[357B][c] VAL[0]; 
g.userMap[357B][c] VAL[0]; 

ENDLOOP; 

g .defaultMap[0][211B] VAL[11BJ; 
g.defaultMap jo]I244B]<- VALI44B]; 
g.defaultMap[0][252B] «■—VAL[428]; 
g .defaultMap[0][272B] <- VAL[42B]; 
g.defaultMap[0][251B]«- VAL[47B]; 
g.defaultMap(0]]271B] <-VAL[47B]; 
g.defaultMap[41B][76B]«—VAL[55B]; 
g .def aultMap[357B][42B] *- VALJ55B]; 
g .defaultMap[357B][41 B] VALJ40B]; 

g.userMap[0]{211B] *- VAL[11B]; 
g.userMap[0][244B]<e~ VAL[44B]; 
g,userMap[0]j252B] VAL[42B]; 
g.userMap[oj(272B]VAL[42B]; 
g.userMap[0](251B] <—VAL[47B]; 
g.userMap[0][271 B]«- VAL[47B]; 
g.userMap[41B][76B] *— VALJ55B]; 
g.userMap[357B][42B]«—VAL[55B]; 
g.userMap[357B][41B] <-VAL[40B]; 

}; 


—/* main line code *7 
Zzlnit]]; 


END... 

LOG 

16-Mar-87 14:06:16 - Caro - Created 
26-Jun-87 11:30:20 - Caro - Added error catcher in ConvertProcoverCreateCommon, 
IS08 now has correct ENDCASE 

10-Jul-87 11:31:10 — Caro - Added before/after line spacing 

19-Aug-87 11:03:02 - Caro - Fixed AR 13535 by updating oldlnstance window 


— 21 IB-> tab 

— dollar -> $ 

— leftDoubleQuote - > " 

— rightDoubleQuote -> " 

— leftSingleQuote -> ' 

— rightSingieQuote -> ' 

— hyphen -> minus 

— nonBreakingHyphen -> minus 

— nonBreakingSpace - > space 

— 21 IB — > tab 

— dollar —> $ 

— leftDoubleQuote -> " 

— rightDoubleQuote-> " 

— leftSingleQuote -> ' 

— rightSingieQuote ->' 

— hyphen -> minus 

— nonBreakingHyphen -> minus 

— nonBreakingSpace -> space 
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Fixed AR 13705 by flush) ng remaining text 
1 b-Sep-87 12:21:09 - Caro - Fixed AR 14393 by terminating with endPara 
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— File*: CvXIitFWImpLmesa 

— Trow 7-Sep-89 16:52:38 

— Last Revised by: Erickson 17-Dec-87 16:03:15 

— Owner: Workstation Applications - Foreign Conversion Team 

— Copyright (c) 1987, 1989 by Xerox Corporation. All rights reserved. 

DIRECTORY 
Attention 
USING (Post], 

ElWSZone 

USING [logonSession, Permanent], 

Catalog 

USING [GetFile], 

Converter 

USING [MenultemProc, ResizeDetail Window], 

CvXlit, 

Environment 

USING [Byte, wordsPerPage], 

FormWindow 

USING [Appendltem, AppendLine, ChoiceChangeProc, ChoiceHintsProc, Choicelndex, 
Choiceltem, Choiceltems, Create, GetBooleanltemValue, GetChoiceltemValue, 
GetlntegerltemValue, GetTextltemValue, 

HasBeenChanged, HasAnyBeenChanged, LayoutProc, Line, MakeltemsProc, 
MakeBooteanltem, MakeChoiceltem, Makelntegerltem, MakeTextltem, 
MinDimsChangeProc, 

SetBooleanltemValue, SetChoiceltemValue, SetlntegerltemValue, 

SetTabStops, SetTextltemValue, 

SetVisibility, TabStops, SetSelection, SetlnputFocus], 

Fo r rnWi ndo wMessag e Pa rse 

USING [FreeChoiceltems, ParseChoiceltemMessage], 

NSAssignedTypes 
USING [tUnspecified], 

NSFile 

USING [AttributesProc, Close, Error, Filter, Find, GetReference, Handle, 

List, nullHandle, n uIIReference, OpenByReference, Reference, Scope, Selections], 
NSFileStream 

USING (Create, Handle], 

NSString 

USING (FreeString, String, StringFromMesaString], 

Space 

USING [ScratchMap, Unmap], 

Stream 

USING [Delete, EndOfStream, GetByte, GetWord], 

Window 

USING [Handle], 

XChar 

USING [Character, Code, Set], 

XCharSetO 
USING [Make], 

XString 

USING [CopyReader, Empty, FreeReaderBytes, FreeWriterBytes, FromNSString, FromSTRING, 
NewWriterBody, NSStringFromReader, nullReaderBody, Reader. 

ReaderBody, WriterBody, InvalidNumber, Overflow]; 


< <: 


— OVERVIEW: 
Formwindow procedures 


> > 

CvXlitFWImpI: PROGRAM 
IMPORTS 

Attention, BWSZone, Catalog,Converter,CvXlit, FormWindow, FormWindowMessageParse, 
NSFile, NSFileStream, NSString, Space, Stream, XChar, XCharSetO, XString 
EXPORTS 
CvXlit = 

BEGIN 


— CONSTANTS 


textWidth: CARDINAL = 320; 

tabStopInterval: CARDINAL = CvXlit.pointsBetweenltems/2; 
charMapSize: CARDINAL = SIZElVPToAsciiCharMap]; 

— TYPES 


Global: TYPE = RECORD [ 
avCount: CARDINAL, 
vaCount: CARDINAL, 

avChoices: ARRAY [0..31)OF FormWindow.Choiceltem, 
vaChoices: ARRAY [0..31) OF FormWindow.Choiceltem, 
cz: UNCOUNTED ZONE]; 

HintArray: TYPE = ARRAY (0..30) OF FormWindow.Choicelndex; 
VPToAsciiCharMap: TYPE = ARRAY [0..256) OF CHARACTER; 
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— GLOBALS 


g: Global[ 
avCount: 0, 
vaCount: 0, 

avChoices; ALL[[string[0, XString.nufIReaderBody]]], 
vaChoices: ALL[[string[0, XString.nullReaderBodyjj], 
cz: BWSZone.Permanent!]]; 

hintsObject: HintArray<- 

11,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,301; 

avHints: LONG DESCRIPTOR FOR ARRAY OF FormWindow.Choicelndex; 
vaHints: LONG DESCRIPTOR FOR ARRAY OF FormWindow.Choicelndex; 


— PUBLIC PROCEDURES 


CommonMenu; PUBLIC Converter.MenultemProc = { 

< < = PROCEDURE [instance: LONG POINTER, menultem: PropertySheet.MenultemType] RETURNS [ok: BOOLEAN «-TRUE]; > > 
my: CvXIit.Common = instance; 

avPara: XString.ReaderBody-e-CyXIitGetMessageldfltAVEndParagraph]; 
avChar: XString.ReaderBody <~CvXlit.GetMessage{dfltAVReplaceCharacter]; 
vaLine: XString.ReaderBody CvXIit.GetMessagetdfltVAEndLine]; 
vaPara: XString.ReaderBody CvXlit.GetMessage[dfltVAEndParagraph]; 
vaChar: XString.ReaderBody «-CvXlit.GetMessage[dfltVAReplaceCharacter]; 

IF my = NIL THEN RETURN[ok: TRUE]; 

SELECT menultem FROM 
defaults = > 

{ 

SELECT my.owner FROM 

AtoVsrc = > 

{ 

FormWindow.SetTextltemValueJ 
window: my.window, 

item: CvXIit.MessageKey.paraEndsWith.ORD, 
newValue: @avPara, 
repaint: FALSE]; 

}; 

AtoVdst = > 

{ 

FormWindow.SetChoiceltemValue! 
window: my.window, 
item: 100, 
newValue: 0, 
repaint: FALSE]; 

FormWindow.SetChoiceltemValue! 
window: my.window, 
item: CvXIit.MessageKey.font.ORD, 
newValue: CvXIit.dfltFont, 
repaint: FALSE]; 

FormWindow.SetChoiceltemValue[ 
window: my.window, 
item: CvXIit.MessageKey.fontSize.ORD, 
newValue: CvXIit.dfltFontSize, 
repaint: FALSE]; 

FormWindow.SetTextltemValue] 
window: my.window, 

item: CvXIit.MessageKey.replaceUnknown.ORD, 
newValue: @avChar, 
repaint: FALSE]; 

FormWindow.SetBooleanltemValue] 
window: my.window, 

item: CvXIit.MessageKey.ignoreTrailing.ORD, 
newValue: CvXIit.dfltTrailing, 
repaint: TRUE]; 

}; 

VtoAdst = > 

{ 

FormWindow.SetChoiceltemValue[ 
window: my.window, 
item: 101, 
newValue: 0, 
repaint: FALSE]; 

FormWindow.SetChoiceltemValue] 
window: my.window, 
item: CvXIit.MessageKey.JineLen.ORD, 
newValue: CvXIit.dfltLineLen, 
repaint: FALSE]; 

FormWindow.SetlntegerltemValue[ 
window: my.window, 
item: CvXIit.MessageKey.charsSuffix.ORD, 
newValue: CvXIit.dfltChars, 
repaint: FALSE]; 

FormWindow.SetBooleanltemValue[ 
window: my.window, 
item; CvXIit.MessageKey.wordWrap.ORD, 
newValue: CvXIit.dfltWordWrap, 
repaint: FALSE}; 

FormWindow.SetTextltemValue! 
window: my.window, 
item: CvXIit.MessageKey.endLine.ORD, 
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newValue: @vaLine, 
repaint: FALSE]; 

FormWindow.SetTextltemValue[ 
window: my.window, 
item: CvXIit.MessageKey.endPara.ORD, 
newValue: @vaPara, 
repaint: FALSE]; 

FormWindow.SetTextltemValuel 
window: my.wtndow, 

item: CvXIit.MessageKey.replaceUnknown.ORD, 
newValue: @vaChar, 
repaint; TRUE]; 

}; 

ENDCASE; 

done = > 

{ 

ENABLE NSFile.Error, CvXIit.Problem = > 

{ 

msgRb: XString.ReaderBody «-CvXlit.GetMessage[doneFailed]; 
Attention.Post[@msgRb]; 

GOTO notOK; 

}; 

IF FormWindow.HasAnyBeenChanged[my.window]THEN 

{ 

ok «- ApplyChanges[my]; 

IF NOTok THEN GOTO notOK; 

CvXIit.StoreFiledDatalmy]; 

}; 

EXITS notOK => RETURN[ok: FALSE]; 

}; 

start = > 

{ 

ok «- ApplyChanges[my]; 

}; 

ENDCASE; 

>; 


CreateFW: PUBLIC PROC[my: CvXIit.Common, window: Window,Handle, owner: CvXIit.Owners] = { 
SELECT owner FROM 

AtoVsrc = > 

{ 

FormWindow.Create[ 
window: window, 
makeltemsProc: MakeAtoVSrc, 
layoutProc: LayoutAtoVSrc, 
minDimsChangeProc: GrowParent, 
clientData: my]; 

CvXlit.DataToWindow[my, window]; 

}; 

AtoVdst = > 

{ 

FormWindow.Create[ 
window: window, 
makeltemsProc: MakeAtoVDst, 
layoutProc: LayoutAtoVDst, 
clientData: my]; 

}; 

VtoAdst = > 

{ 

FormWindow.Crea te[ 
window: window, 
makeltemsProc: MakeVtoADst, 
layoutProc: LayoutVtoADst, 
minDimsChangeProc: GrowParent, 
clientData: my]; 

CvXlit.DataToWindow[my, window]; 

>; 

backstop ~ > 

{ 

FormWindow.Create[ 
window: window, 
makeltemsProc: MakeBackstop]; 

>; 

ENDCASE; 


— PROCEDURES 


AppiyChanges: PROC [my: CvXIit.Common] RETURNS Jok: BOOLEAN TRUE] = { 

bufWb: XString.WriterBody«— XString.NewWriterBody[maxLength: 30, z: my.z]; 

tf: NSFile.Handle; 

ts: NSFileStream.Handle; 

zero: [0..256); 

char: CHARACTER; 

xchar: XChar.Cbaracter; 

avt; CvXIit.AsciiToVPTable; 

vat: CvXIit.VPToAsciiTable; 

tableName: XString.ReaderBody; 

tableO: XString.ReaderBody; 

tempChoice: FormWindow.Choiceltem; 

tableChoice: FormWindow.Choicelndex; 

SELECT my,owner FROM 
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AtoVsrc = > 

{ 

IF FormWindow.HasBeenChangedlwindow: my.window, item: CvXIit.MessageKey.paraEndsWith.ORD] THEN 

IF my.textRb[paraEndsWith] # XString.nullReaderBody THEN 

XString.FreeReaderBytes[@my.textRb(para£ndsWith], my.zj; 
my,textRb{paraEndsWith]«■— FormWindow.GetTextltemValue] 
window: my.window, 

item: CvXIit.MessageKey.paraEndsWith.ORD, 
zone: my.z]; 

}; 

{ok: ok, Is: my.textfparaEndsWith]] <-CvXlit.Parseltem[ 
my: my, 

r: @my.textRb(paraEndsWith], 
item: CvXIit.MessageKey.paraEndsWith, 
buf: @bufWb); 

IF NOT ok THEN RETURN; 

}; 

AtoVdst = > 

{ 

IF FormWindow.HasBeenChangedJmy. window, 100] THEN 
—/* set conversion map */ 

tableChoice <—FormWindow.GetChoiceltemVa!ue[window: my.window, item: 100]; 

avtCvXlit.GetAVTable[]; 

FOR c: CHARACTER IN CHARACTER DO 

avt[c] <—XCharSetO.Make[LOOPHOLE{c]]; 

ENDLOOP; 

tempChoice <- g.avChoices[tableChoice]; 

WITH tempChoice SELECT FROM 

string = > {tableName string}; 

ENDCASE; 

IF ~XString.Emptyl@tableName} THEN 

{ 

tf *- GetTableFile[tableName]; 
ts«-NSFileStream.Create[file: tf]; 

DO 

ENABLE {Stream.EndOfStream => EXIT}; 

(]Stream.Get8yte[ts]; 
char LOOPHOLE{5tream.GetByte[ts]]; 
xchar <— LOOPHOLE[$tream.GetWord[ts]]; 
avt[char] «-xchar; 

ENDLOOP; 

Stream.Delete[ts]; 
ts <— [NIL]; 

tempChoice <e-g.avChoices{0]; 

WITH tempChoice SELECT FROM 
string = > {tableO«—string}; 

ENDCASE; 

IF tableO # XString.nullReaderBody THEN 
XString.FreeReaderBytes|@tableO, g.czj; 

IF my.textRbfavTableName] # XString.nullReaderBody THEN 

XString.FreeReaderBytes[@my.textRb[avTableName], my.z]; 
g.avChoices[0] *- (string[choiceNumber: 0, string: XString.CopyReader{@tableName, g.cz] f ]]; 
my.textRb[avTableName]«- XString.CopyReader[@tableName, g.czj f ; 

FOR i ^CARDINAL IN [1 ..g.avCount] DO 
tempString: XString.ReaderBody; 

WITH g.avChoices(i] SELECT FROM 

string = > {tempString *-string}; 

ENDCASE; 

XString.FreeReaderBytesI@tempString, g.cz]; 
g.avChoicesfiJ <- tstring[i, XString.nullReaderBody]]; 

ENDLOOP; 

}; 

IF FormWindow.HasBeenChanged(my.window, CvXIit.MessageKey.font.ORD] THEN 

my.f.fontFormWindow.GetChoiceltemValue[ 
window: my.window, 
item: CvXIit.MessageKey.font.ORD]; 

}; 

IF FormWindow.HasBeenChangedlmy.window, CvXIit.MessageKey.fontSize.ORD] THEN 

my.f.fontSize FormWindow.GetChoiceltemValue[ 
window: my.window, 
item: CvXIit.MessageKey.fontSize.ORD]; 

IF FormWindow.HasBeenChanged[my.window, CvXIit.MessageKey.replaceUnknown.ORDJ THEN 

IF my.textRblatovReplaceUnknown] # XString.nullReaderBody THEN 
XString.FreeReaderBytesl@my.textRb[atovRepfaceUnknownJ, my.zl; 
my.textRblatovReplaceUnknown]<- FormWindow.GetTextltemValue[ 
window: my.window, 

item: CvXIit.MessageKey.replaceUnknown.ORD, 
zone: my.z]; 

}; 

[ok: ok. Is: my.text(atovReplaceUnknownl] «-CvXiit,Parseltem[ 
my: my, 

r: @my.textRb[atovReplaceUnknown], 
ite m: CvXI it. M essageKey. re place U n known, 
buf: @bufWb]; 

IF NOTokTHEN RETURN; 

IFFormWindow.HasBeenChangedlmy.window, CvXIit.MessageKey.ignoreTrailing.ORD] THEN 
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{ 

my.f.ignoreTrailing.value «— FormWindow.GetBooleanltemValue{ 
window: my.window, 

item: CvXiit.MessageKey.ignoreTrailing.ORD], 

}; 

}; 

VtoAdst = > 

{ 

IF FormWindow.HasBeenChangedlmy.window, 101] THEN 

{ 

charMap: LONG POINTER TO VPToAsciiCharMap; 
xset: [0..256); 

—/* set conversion map */ 

tableChoice «- FormWindow.GetChoiceltemValue[window: my.window, item: 101]; 

vat CvXlit.GetVATable[]; 

NewUserMap(vat); 

tempChoice <- g.vaChoicesJtableChoice]; 

WITH tempChoice SELECT FROM 

string = > {tableName «- string}; 

ENDCASE; 

IF ~XString.Empty[@tableName] THEN 

{ 

tf «- GetTableFile[tableName]; 
ts<- NSFileStream.Create[file: tf]; 

DO 

ENABLE {Stream.EndOfStream => EXIT}; 
xchar<- LOOPHOLE(Stream.GetWord[tsj]; 
zero <— Stream. GetByte[ts]; 
char LOOPHOLE (Stream.GetByte(ts]]; 

IF zero #0 THEN LOOP; 
xset *-XChar.$et(xchar]; 
charMap «- vat[xset]; 

IF charMap = NILTHEN { 

vat(xset]<-Space.ScratchMap((charMapSize + Environment.wordsPerPage-1) / Environment.wordsPerPage]; 
FOR c: CARDINAL IN 10. 256) DO 
vat[xset]]c] VAL(0]; 

ENDLOOP; 

charMap «-vat] xset]; 

}; 

charMap[XChar.Code[xchar]] «--- char; 

ENDLOOP; 

Stream. Delete |ts]; 
ts<- [NIL]; 

tempChoice <-g.vaChoices[0]; 

WITH tempChoice SELECT FROM 
string = > {tabie0<-string}; 

ENDCASE; 

IF tableO # XString.nullReaderBody THEN 

XString.FreeReaderBytes(@tableO, g.cz]; 

IF my.textRb(vaTableName] # XString.nullReaderBody THEN 

XString.FreeReaderBytes[@my.textRb[vaTableName], my.z]; 
g.vaChoices{Ol«-lstring[choiceNumber: 0, string: XString.CopyReader(@tableName,g.cz] f ]]; 
my.textRb[vaTableName]<-XString.CopyReader[@tableName,g.cz] |; 

}; 

FORi: CARDINAL IN [1..g.vaCount] DO 
tempstring: XString.ReaderBody; 

WITH g.vaChoices[i] SELECT FROM 

string = > {tempString <— string}; 

ENDCASE; 

XString.FreeReaderBytes[@tempString,g.cz]; 
g.vaChoices[i] [string(i, XString.nullReaderBody]]; 

ENDLOOP; 

}; 


IF FormWindow.HasBeenChanged[my.window, CvXlit.MessageKey.lineLen.ORD] THEN 

{ 

my.f.lineLen <— FormWindow.GetChoiceltemValuel 
window: my.window, 
item: CvXlit.MessageKey.lineLen.ORD]; 

}; 

IF FormWindow.HasBeenChangedlmy.window, CvXIit.MessageKey.charsSuffix.ORD] THEN 

{ 

my.f.charsSuffix «-CARDINAL[FormWindow.GetlntegerltemValue[window: my.window, 
item: CvXIit.MessageKey.charsSuffix.ORD I 
XString.InvalidNumber — > { 

msgRb: XString.ReaderBody ■e-CvXHt.GetMessage[extraErr1]; 

Attention.Post[@msgRbl; 

GOTO Badnum; 

}; 

XString.Overflow = > { 
my.f.charsSuffix «- 0; 

CONTINUE; 

> 11 ; 

IF my.f.charsSuffix NOT IN (10..256] THEN 

msgRb: XString.ReaderBody*- CvXIit.GetMessagelcharsOutOfBounds]; 

Atte nt io n. Post[@m sg Rb] ; 

GOTO Badnum; 
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EXITS 

Badnum = > { 

EormWindow.SetSelectionlwindow: my.window, 

item: CvXIit.MessageKey.charsSuffix.ORD, 
firstChar: 0, lastChar: CARDINAL LAST]; 
FormWindow.SetlnputFocusJwindow: my .window, 

item: CvXiit.MessageKey.charsSuffix.ORD, 
beforeChar: CARDINAL. LAST); 

RETURNlok: FALSE]; 

}; 

}; 


IF FormWindow.HasBeenChangedlmy.window, CvXIit.MessageKey.wordWrap.ORD] THEN 


my.f.wordWrap.value FormWindow.GetBooleanltem Value] 
window: my.window, 
item: CvXIit.MessageKey. wordwrap.ORD]; 


IF FormWindow.HasBeenChangedlmy.window, CvXIit.MessageKey.endLine.ORD] THEN 

IF my.textRb[endLine] # XString.nullReaderBody THEN 
XString.FreeReaderBytes[@my.textRb[endLinel, my.z]; 

my.textRbfendLine] 4 - FormWindow.GetTextltemValuel 
window: my.window, 
item: CvXIit.MessageKey.endLine.ORD, 
zone: my.z]; 

}; 

!ok: ok, Is: my.text[endLine]] CvXIit.Parseltemf 
my: my, 

r: @my.textRbfendLine], 
item: CvXIit.MessageKey.endLine, 
buf: @bufWb]; 

IF NOT ok THEN RETURN; 


IF FormWindow.HasBeenChangedfmy.window, CvXiit.MessageKey.endPara.ORD] THEN 

IF my.textRbfendPara] # XString.nullReaderBody THEN 

XString.FreeReaderBytes(@my.textRb(endPara], my.z]; 

my.textRbfendPara] <- FormWindow.GetTextltemValuel 
window: my.window, 
item: CvXiit.MessageKey.endPara.ORD, 
zone: my.z]; 

}; 

[ok: ok, Is: my.textfendPara]] 4 - CvXIit.Parseltemf 
my: my, 

r: @my.textRb[endPara], 
item: CvXIit.MessageKey.endPara, 
buf; @bufWb]; 

IF NOT ok THEN RETURN; 


IF FormWindow.HasBeenChangedfmy.window, CvXIit.MessageKey.replaceUnknown.ORD] THEN 

IF my.textRbfvtoaReplaceUnknown] # XString.nullReaderBody THEN 
XString.FreeReaderBytesf@my.textRb[vtoaReplaceUnknown], my.zj; 
my.textRbfvtoaReplaceUnknown] •*— FormWindow.GetTextltemValuel 

window: my.window, 

item: CvXIit.MessageKey.replaceUnknown.ORD, 
zone: my.z]; 


}; 

fok: ok, Is: my.textfvtoaReplaceUnknown]] 4 - CvXIit.Parseltemf 
my: my, 

r: @my.textRbfvtoaReplaceUnknown], 
item: CvXIit.MessageKey.replaceUnknown, 
buf: @bufWb]; 

IF NOT ok THEN RETURN; 


}; 

ENDCASE; 


X$tring.FreeWriterBytes[@bufWb]; 
}; — ApplyChanges 


GrowParent: FormWindow.MinDimsChangeProc = { 

< < = PROCEDURE [window: Window.Handle, old: Window.Dims, new: Window Dims]- 

> > 

my: CvXIit.Common = CvXIit.DataFromWindowfwindow]- 
oldHeight: INTEGER; 

—/* don't adjust the first time window is viewed *7 
IF my = NIL THEN RETURN; 

IF old = new THEN RETURN; 

—/* defaulting newHeight returns oldHeight without resizing */ 
oldHeight <-Converter.ResizeDetailWindow[ 
cvData: my.cvData, 
window: window, 

which: IF my.owner = AtoVsrc THEN source ELSE destination]; 

—/* now resize window *1 
[] <-Converter.ResizeDetailWindowf 
cvData: my.cvData, 
window: window, 

which: IF my.owner = AtoVsrc THEN source ELSE destination, 
newHeight: oldHeight + (new.h -old.h)]; 
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MakeBackstop: FormWindow.MakeltemsProc = { 

tag: XString.ReaderBody CvXlit.GetMessage[backstop]; 

FormWindow.MakeTextltem[ 
window: window, 

myKey: CvXIit.MessageKey.backstop.ORD, 

boxed: FALSE, 

readonly; TRUE, 

width: 400, 

initString: @tag]; 


AVHints: FormWindow.ChoiceHintsProc = { 
RETURN [hints: avHints, freeHints: NIL]; 

}; 


VAHints: FormWindow.ChoiceHintsProc = { r j. / C\ CSC 

RETURN[hints: vaHints, freeHints: NIL]; 

}; 


MakeAtoVDst: FormWindow.MakeltemsProc = { 

< < = PROCEDURE [window: Window.Handle, dientData: LONG POINTER]; 

> > 

my: CvXIit.Common = dientData; 
tag: XString.ReaderBody; 
tmp: XString.ReaderBody; 

tag <— CvXlit.GetMessage[transliterationTable]; 

BEGIN 

folder: NSFile.Handle «-GetTableFoider[]; 

ListTablesIfolder]; 

NSFile.Close[folder]; 

avHints <- DESCRIPTOR[BASE[hintsObject], g.avCount]; 

FormWi n dow. MakeChoicelteml 
window: window, 
myKey: 100, 
tag: @tag, 

values: DESCRIPTORIg.avChoices], 
initChoice: 0, 
fullyDisplayed: FALSE, 
hintsProc: AVHints]; 

END; 

tag CvXIit.GetMessageffont]; 
trnpCvXlit.GetMessage[fontChoices]; 

BEGIN 

values: FormWindow.Choiceltems «-FormWindowMessageParse.ParseChoiceltemMessage[choiceltemMessage: ©tmp, zone: my.z]; 
FormWindow.MakeChoiceltemf 
window: window, 

myKey: CvXlit.MessageKey.font.ORD, 
tag: @tag, 
values: values, 
initChoice: my.f.font, 
fullyDisplayed: TRUE]; 

FormWindowMessageParse.FreeChoiceltemsfchoiceltems: values, zone: my.z}; 

END; 

tag <- CvXlit.GetMessage[fontSize]; 
tmp t- CvXlit.GetMessage[fontSizeChoices]; 

BEGIN 

values: FormWindow.Choiceltems •<-FormWindowMessageParse.ParseChoiceltemMessage[choiceitemMessage: ©tmp, zone: my.z]; 
FormWindow.MakeChoicelteml 
window: window, 

myKey: CvXIit.MessageKey.fontSize.ORD, 
tag: @tag, 
values: values, 
initChoice: my.f.fontSize, 
fullyDisplayed: TRUE]; 

FormWindowMessageParse.FreeChoiceltemslchoiceltems: values, zone: my.z]; 

END; 

tag CvXlit.GetMessage[replaceUnknown]; 

FormWindow,MakeTextltem[ 
window: window, 

myKey: CvXIit.MessageKey.replaceUnknown.ORD, 
tag: @tag, 
width: textWidth, 

initString: @my.textRb[atovReplaceUnknown]]; 

tag CvXlit.GetMessage[ignoreTrailing]; 

FormWindow.MakeBooleanltem] 
window: window, 

myKey: CvXIit.MessageKey.ignoreTrailing.ORD, 
label: (string[tag]], 

initBoolean: my.f.ignoreTrailing.value]; 


MakeAtoVSrc: FormWindow.MakeltemsProc = { 

< < = PROCEDURE [window: Window.Handle, dientData: LONG POINTER]; 

> > 

my: CvXIit.Common = dientData; 
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tag: XString.ReaderBody; 


tag «-CvXlit.GetMessage[paraEndsWith]; 
FormWindow. MakeTextltem( 
window: window, 

myKey: CvXiit.MessageKey.paraEndsWith.ORD, 
tag: @tag, 
width: textWidth, 

initString: @my.textRb[paraEndsWith]]; 


MakeVtoADst: FormWindow.MakeltemsProc = { 

< < = PROCEDURE [window: Window.Handle, clientData; LONG POINTER]; > > 
my: CvXIit.Common = clientData; 
tag: XString.ReaderBody; 
trnp: XString.ReaderBody; 

tag CvXlit.GetMessage(transliterationTable]; 

BEGIN 

folder: NSFile.Handle «-GetTableFolderU; 

ListVATables[f older]; 

NSFile. Close[folder]; 

vaHints*- DESCRIPTOR[BASE[hintsObject], g.vaCount]; 

FormWindow. MakeChoiceltem[ 
window: window, 
myKey: 101, 
tag: @tag, 

values: DESCRIPTOR^,vaChoices], 
initChoice: 0, 
fullyDisplayed: FALSE, 
hintsProc: VAHints]; 

END; 

tag «~CvXlit,GetMessage[lineLen]; 
trnp <r- CvXlit.GetMessage{lineLenChoices]; 

BEGIN 

values: FormWindow.Choiceltems FormWindowMessageParse.ParseChoiceitemMessage[choiceltemMessage: @tmp, zone: my.z]; 
FormWindow. MakeChoiceltem( 
window: window, 

myKey: CvXIit.MessageKey.lineLen.ORD, 
tag: @tag, 
values: values, 
initChoice: my.f.lineLen, 
changeProc: LineLenXProc, 
fullyDisplayed: TRUE]; 

FormWindowMessageParse.FreeChoiceltems[choiceltems: values, zone: my.z]; 

END; 

tag <-CvXiit.GetMes$age[charsSuffixJ; 

FormWindow.Makelntegerltemf 
window: window, 

myKey: CvXIit.MessageKey.charsSuffix.ORD, 
suffix: @tag, 

visibility: IF my.f.lineLen = CvXIit.limited THEN visible ELSE invisible, 
signed: FALSE, 
width: 30, 

initlnteger: INTEGER[my.f.charsSuffix]]; 

tag <r~ CvXIit.GetMessage[wordWrap]; 

FormWindow.MakeBooleanlteml 
window: window, 

myKey: CvXIit.MessageKey.wordWrap.ORD, 

visibility: IF my.f.lineLen = CvXIit.limited THEN visible ELSE invisible, 

label: [string[tag]], 

initBoolean: my.f.wordWrap.value]; 

tag *— CvXlit.GetMessage[endLine]; 

FormWindow. MakeTextltem] 
window: window, 

myKey: CvXIit.MessageKey.endLine.ORD, 
tag: @tag, 
width: textWidth, 
initString: @my.textRb[endLine]]; 

tag •e- CvXIit.GetMessage[endPara]; 

FormWindow. MakeTextlteml 
window: window, 

myKey: CvXIit.MessageKey.endPara.ORD, 
tag: @tag, 
width: textWidth, 
initString: @my.textRb[endPara]]; 

tag «- CvXlit.GetMessage[replaceUnknown]; 

FormWindow. M a keTextltem] 
window: window, 

myKey: CvXIit.MessageKey.replaceUnknown.ORD, 
tag: @tag, 
width: textWidth, 

initString: @my.textRb(vtoaReplaceUn known]]; 


LayoutAtoVDst; ForrnWindow.LayoutProc = { 

< < = PROCEDURE (window: Window.Handle, clientData: LONG POINTER]; 

> > 

leadingMargin: CARDINAL = CvXIit.leadingMargin; 
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spaceAboveLine: CARDINAL = 5; 
line: FormWindow.Line; 

tabChoice: fixed FormWindow.TabStops = (fixedltabStopInterval]]; 

FormWindow.5etTabStops(window, tabChoice]; 

line «- FormWindow.AppendLine(window, spaceAboveLine]; 
FormWindow.Appendlteml 
window: window, 
item: 100, 
line: line, 

preMargin: CvXlit.GetPreMargin[transliterationTable] MODtabStopInterval, 
tabStop: CvXlit.GetPreMargin[transliterationTab(e] / tabStopInterval, 
repaint: FALSE]; 

line FormWindow.AppendLinelwindow, spaceAboveLine]; 
FormWindow.Appendlteml 
window: window, 
item: CvXlit.MessageKey.font.ORD, 
line: line, 

preMargin: CvXlit.GetPreMargin[font] MODtabStopInterval, 
tabStop: CvXIit.GetPreMarginlfont] / tabStopInterval, 
repaint: FALSE]; 

line«- FormWindow.AppendLinelwindow, spaceAboveLine]; 
FormWindow.Appendlteml 
window: window, 

item: CvXIit.MessageKey.fontSize.ORD, 
line: line, 

preMargin: CvXIit.GetPreMarginlfontSize] MODtabStopInterval, 
tabStop: CvXIit.GetPreMarginlfontSize] / tabStopInterval, 
repaint: FALSE]; 

line <— FormWindow.AppendLinelwindow, spaceAboveLine]; 
FormWindow.Appendlteml 
window: window, 

item: CvXIit.MessageKey.replacellnknown.ORD, 
line: line, 

preMargin: CvXlit.GetPreMargin[replaceUnknown] MOD tabStopInterval, 
tabStop: CvXIit.GetPreMarginlreplaceUnknown] / tabStopInterval, 
repaint: FALSE]; 

line «- FormWindow.AppendLinelwindow, spaceAboveLine]; 
FormWindow.Appendlteml 
window: window, 

item: CvXIit.MessageKey.ignoreTrailing.ORD, 
line: line, 

preMargin: CvXlit.GetPreMargin[ignoreTrailing] MOD tabStopInterval, 
tabStop: CvXIit.GetPreMarginlignoreTrailing] / tabStopInterval, 
repaint: FALSE]; 




LayoutAtoVSrc: FormWindow.LayoutProc = { 

<< =■■ PROCEDURE [window: Window.Handle, clientData: LONG POINTER]; 

> > 

leadingMargin: CARDINAL = CvXIit.leadingMargin; 
spaceAboveLine: CARDINAL = 5; 
line: FormWindow.Line; 

tabChoice: fixed FormWindow.TabStops = [fixedltabStopInterval]]; 

FormWindow.SetTabStops[window, tabChoice]; 

line ♦— FormWindow.AppendLinelwindow, spaceAboveLine]; 
FormWindow.Appendlteml 
window: window, 

item: CvXIit.MessageKey.paraEndsWith.ORD, 
line: line, 

preMargin: CvXIit.GetPreMarginlparaEndsWith] MODtabStopInterval, 
tabStop: CvXIit.GetPreMarginlparaEndsWith] / tabStopInterval, 
repaint: FALSE]; 


Layout'VtoADst: FormWindow.LayoutProc = { 

< < = PROCEDURE (window: Window.Handle, clientData: LONG POINTER]; >> 
leadingMargin: CARDINAL = CvXIit.leadingMargin; 
spaceAboveLine: CARDINAL = 5; 
line: FormWindow.Line; 

tabChoice: fixed FormWindow.TabStops = [fixedltabStopInterval]]; 

FormWindow.SetTabStops[window, tabChoice]; 

line <- FormWindow.AppendLinelwindow, spaceAboveLine]; 
FormWindow.Appendlteml 
window: window, 
item; 101, 
line: line, 

preMargin: CvXlit.GetPreMargin[transliterationTable] MOD tabStopInterval, 
tabStop: CvXlit.GetPreMargin[transliterationTable] / tabStopInterval, 
repaint: FALSE]; 

line *- FormWindow.AppendLinelwindow, spaceAboveLine]; 

FormWi ndow. Appe nd Item! 
window: window, 

item; CvXIit.MessageKey.lineLen.ORD, 
line: line, 

preMargin; CvXlit.GetPreMargin|lineLen] MODtabStopInterval, 
tabStop: CvXIit.GetPreMarginllineLen] / tabStopInterval, 
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repaint: FALSE]; 

FormWindow.Appendlteml 
window: window, 

item: CvXIit.MessageKey.charsSuffix.ORD, 
line: line, 

preMargin: CvXiit.GetPreMargin[charsSuffix], 
tabStop:, 
repaint: FALSE]; 

FormWindow.Appendlteml 
window: window, 

item: CvXIit.MessageKey.wordWrap.ORD, 
line: line, 

preMargin: CvXlit.GetPreMargin|wordWrap], 
tabStop:, 
repaint: FALSE]; 

line*- Form Window.AppendLine[window, spaceAboveLine]; 
FormWindow.Appendlteml 
window: window, 

item: CvXIit.MessageKey.endLine.ORD, 
line: line, 

preMargin: CvXIit.GetPreMarginlendLine] MOD tabStopInterval, 
tabStop: CvXIit.GetPreMarginlendLine] / tabStopInterval, 
repaint; FALSE]; 

line *- FormWindow.AppendLine(window, spaceAboveLine]; 
FormWindow.Appendlteml 
window: window, 

item: CvXIit.MessageKey.endPara.ORD, 
line: line, 

preMargin: CvXiit.GetPreMargin[endPara] MOD tabStopInterval, 
tabStop: CvXIit.GetPreMarginlendPara] / tabStopInterval, 
repaint: FALSE]; 

line <— FormWindow.AppendLinelwindow, SpaceAboveLine]; 
FormWindow.Appendlteml 
window: window, 

item: CvXIit.MessageKey.replaceUnknown.ORD, 
line: line, 

preMargin: CvXlit.GetPreMargin[replaceUnknown] MOD tabStopInterval, 
tabStop: CvXIit.GetPreMarginlreplaceUnknown] / tabStopInterval, 
repaint: FALSE]; 


—/*Change Procs *t 

LineLenXProc: FormWindow.ChoiceChangeProc = { 

< < =s PROCEDURE [window: Window.Handle, item: FormWindow.itemKey, calledBecauseOf: FormWindow.ChangeReason, oldValue: 
FormWindow.Choicelndex, newVaiue: FormWindow.Choicelndex]; 

> > 

IF newVaiue = oldValue THEN RETURN; 

IF newVaiue = CvXIit.limited THEN 

{ 

FormWi ndow.SetVisibi lityl 
window: window, 

item: CvXIit.MessageKey.charsSuffix.ORD, 
visibility: visible, 
repaint: FALSE]; 

FormWindow.SetVisibilityl 
window: window, 

item: CvXIit.MessageKey.wordWrap.ORD, 
visibility: visible, 
repaint: TRUE]; 

} 

ELSE 

{ 

FormWindow.SetVisibilityl 
window: window, 

item: CvXiit.MessageKey.charsSuffix.ORD, 
visibility: invisible, 
repaint: FALSE]; 

FormWindow.SetVisibilityl 
window: window, 

item: CvXIit.MessageKey.wordWrap.ORD, 
visibility: invisible, 
repaint: TRUE]; 

}; 

}; 


—/* Table Procs */ 


FindTableFolder: PROC [directory: NSFile.Handle] 

RETURNS [tableFolder: NSFile.Handle *— NSFile.nullHandle] = { 
filters: ARRAY |0..2> OF NSFile.Filter 1 

[matches[[name|NSString.StringFromMesaString("Transliteration Tables *'L|]]J], 
[equallltypelNSAssignedTypes.tDirectory]]]]]; 

— should look on desktop and then in System catalog 

tableFolder NSFile. Find| 

directory; directory, scope: [filter: [and[DESCRIPTOR [filters]]]]! NSFile.Error = > CONTINUE]; 
directory Catalog.GetFile [name: folderName, readonly: TRUE]; 

FileFromName [fileName]; 

MSFile.Close [directory]; 
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ListTables: PROC [folder: NSFiie.Handle] = { 
filters: ARRAY (0..2) OF NSFile.Filter[ 

[match es[[name[NSString.StringFromMesaString["*.avTable"L]]]]], 

[equal [[type[NSAssignedTypes,tUnspecified]]]]]; 
scope: NSFile.Scope<-[ 
count: 30, 

filter: [and[DESCRIPTOR [filters]]]]; 
selections: NSFile.Selections; 

CopyTableName: NSFile.AttributesProc = { 

cd: LONG POINTER TO Global <e- clientData; 

name: XString.ReaderBody <-XString.FromNSStringfattributes.name]; 
cd.avCount cd.avCount + 1; 
cd.avChoices[cd.avCount] *- [string[ 
choiceNumber: cd.avCount, 
string: XString.CopyReader[@name, cd.cz] f ]]; 


selections,interpreted[name] ■e-TRUE; 
g.avCount «■—0; 

NSFiie.List[ 

directory: folder, 
proc: CopyTableName, 
selections: selections, 
scope: scope, 

clientData: @g ! NSFile.Error = > CONTINUE]; 


UstVATables: PROC [folder: NSFile.Handle] = { 
filters: ARRAY [0..2) OF NSFiie.Filter[ 

[matches[[name[NSString,StringFromMe$aString["*.vaTable"l]]]]], 
[equal[[type[NSAssignedTypes.tUnspecified]]]]]; 
scope: NSFiie.Scope <-[ 
count: 30, 

filter: (and[DESCRIPTOR [filters]]]]; 
selections: NSFile.Selections; 

CopyTableName: NSFile.AttributesProc = { 

cd: LONG POINTER TO Global clientData; 

name: XString.ReaderBody «— XString.FromNSString[attributes.name|; 
cd.vaCount«~cd.vaCount + 1; 
cd.vaChoices[cd.vaCount] {string[ 

choiceNumber: cd.vaCount, 
string: X$tring.CopyReader[@name, cd.cz] f ]]; 


selections.interpreted[name] «-TRUE; 
g.vaCount «—0; 

NSFiie,List[ 

directory: folder, 
proc: CopyTableName, 
selections: selections, 
scope: scope, 

clientData: @g I NSFile.Error - > CONTINUE]; 


GetTableFolder: PROC RETURNS [folder: NSFile.Handle] = { 

— assume folder is in System catalog 

folderName: XString.ReaderBody <—XString.FromSTRING[”Transliteration Tables M L]; 
folders-Catalog.GetFile[name: @folderName, readonly: TRUE]; 


GetTableFile: PROC [tableName: XString.ReaderBody] RETURNS [file: NSFile.Handle] = { 
— assume folder is in System catalog 

folderName: XString.ReaderBody <- XString.FromSTRING["Transliteration Tables"L]; 

ref: NSFiie.Reference <— TRASH; 

ref GetFi!e[@folderName, @tableNa me]; 

file *r- NSFiie.OpenByReference[ref]; 

}; 


GetFile: PROC [folderName,fileName: XString.Reader] 

RETURNS [file: NSFiie.Reference «=- NSFiie.nullReference] = { 
directory: NSFile.Handle TRASH; 

FileFromName: PROC [value: XString.Reader] - { 

nsName: NSString.String XString.NSStringFromReader[ 
r: value, z: BWSZone.logonSession]; 
handle: NSFiie,HandleNSFiie.nullHandle; 

handle NSFiie.Find! 
directory: directory, 

scope: [filter: [matches[attribute: [name[nsName]]]|] 

I NSFile.Error = > {handle NSFiie.nullHandle; CONTINUE]]; 

IF handle # NSFiie.nullHandle THEN { 
file <— NSFile.GetReference[handle]; 

NSFiie.Close[handle]]; 

NSString.FreeStrtnglz: BWSZone.logonSession, s: nsNamel; 


directory Catalog.GetFile[name: folderName, readonly: TRUE]; 
FileFromName[fileName]; 

NSFile.Close[directory]; 
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}; 


NewUserMap: PROC [userMap: CvXIit.VPToAsciiTable] = { 

—/* initialize conversion maps */ 

FOR s: CARDINAL IN [0..256) DO 

IF userMap[s] # NIL THEN userMap[s]«- Space.Unmap[userMap[s]]; 

ENDLOOP; 

userMap[0] <r-Space.ScratchMap[(charMapSize + Environment.wordsPerPage-1) / Environment.wordsPerPage]; 
userMap[41 B]Space.ScratchMap[(charMapSize + Environ ment.wordsPerPage-1) / Environment.wordsPerPage]; 
userMap[357B]<^- Space.ScratchMap[(charMapSize + Environment.wordsPerPage-1)/ Environment.wordsPerPage]; 

FOR c: CARDINAL IN [0..256) DO 
userMap{0] [c] VAL[c]; 
userMap{41 B]]c]«- VAL[0]; 
userMap(357B]{c] «-VAL[0]; 

ENDLOOP; 

userMap[0](21 IB] <—VAL[1 IBL- 
userMapIOJ^B] <-VALf44B]; 
userMap[0][252B] «-VAL[42B]; 
userMap[0][272B] «-VAL[42B]; 
userMap[0][251B] *-VAL[47B]; 
userMap[0][271B] <~VAL[47B]; 
userMap[41B][76B] c—VAL[55B]; 
userMap(357B][42B] <- VAL]55B]; 
userMap[357B][41B]«-VAL[40B]; 


END... 

LOG 

16- Mar-87 14:06:16 - Caro - Created 
24-Nov-87 16:58:56 - Erickson - Changed paraEndsWith default to <CR> instead of <CR><LF> 

17- Dec-87 15:48:52 - Erickson - AR 16414 - Added to ApplyChanges in the CvXIit.MessageKey.charsSuffix section. The value read from the 
prop sheet was expected to be a valid number. If text was entered, the converter crashed the system. I added signal checking for 
InvalidNumber and Overflow. If text is entered, the InvalidNumber signal is raised by FormWindow.GetlntegerltemValue, and is caught 
here. The user's input is then highlighted, that field of the propsheet is made the input focus, and a message is posted indicating the 
problem. This message was placed in the extraErrt position in CvXiitMsgFilelmpl.mesa. While I was here, I added a catch phrase for the 
Overflow signal also, this simply sets the input value to zero and allows the already existing code to treat this as input out of range. 


— 21 IB-> tab 

— dollar -> $ 

— leftDoubleQuote -> “ 

— rightDoubleQuote -> " 

— leftSingleQuote -> ' 

— rightSingleQuote -> ' 

— hyphen -> minus 

— nonBreakingHyphen -> minus 

— nonBreakingSpace -> space 


CvXIitFWimpl.mesa 


7-Sep-89 16:52:39 PDT 


12 





— File: CvXIitMainlmpl.mesa 

— Trow 7--Sep-89 16:39:53 

— Last Revised by: Caro 30-Jun-87 12:39:53 

— Owner: Workstation Applications - Foreign Conversion Team 

— Copyright (c) 1987, 1988 by Xerox Corporation. AH rights reserved. 

DIRECTORY 

Atom 

USING [MakeAtom], 

Attention 
USING [Post], 

UWSZone 

USING (Permanent], 

Context 

USING [Create, Error, Find, NopDestroyProc, Type, UniqueTypel, 

Converter 

USING (DestinationOptions, GetEventType, Register, Status, SourceOptions], 
ConverterMsg 

USING (Get, kvpDocument], 

ConverterPFOptions 
USING [conASCII], 

CvXlit 

USING [AsciiToVP, AsciiToVPDstOps, AsciiToVPSrcOps, Common, 

GetMessage, leadingMargin, MessageKey, 
pointsBetweenltems, ProblemType, VPToAscii, VPToAsciiDstOps], 

Event 

USING [AddDependency, AgentProcedure, EventType], 

Process 

USING [Detach, Pause, SecondsToTicks], 

ProductFactoring 
USING [Enabled], 

SimpleTextDisplay 

USING IMeasureString], 

StarFileTypes 

USING [document, text, unspecified]. 

Window 

USING (Handle], 

XString 

USING [ReaderBody]; 

< < 

— OVERVIEW: 


Main code for ascii conversion. Registations done here 



CvXIitMainlmpI: PROGRAM 
IMPORTS 

Atom, Attention, BWSZone, Context, Converter, ConverterMsg, 
CvXlit, Event, Process, ProductFactoring, SimpleTextDisplay 
EXPORTS 
CvXlit = 

BEGIN 


— CONSTANTS 


Globals: TYPE = RECORD [ 
leads: ItemLeads, 
ctype: Context.Type, 
z; UNCOUNTED ZONE]; 

ItemLeads: TYPE = ARRAY CvXlit.MessageKey[paraEndsWith..lastPsheetltem] OF CARDINAL; 


— GLOBALS 


g: Globals; 


— PUBLIC SIGNALS 


Problem: PUBLIC SIGNAL [err: CvXiit.ProblemType] = CODE; 


— PUBLIC PROCEDURES 


DataFromWindow: PUBLIC PROC [w: Window.Handle] RETURNS [my: CvXIit.Common] = { 

my «-• Context.Find[type: g.ctype, window: w ! Context.Error = > {my«- NIL; CONTINUE}]; 


DataToWindow: PUBLIC PROC [my: CvXIit.Common, w: Window.Handle] = { 
Context.Create[ 
type: g.ctype, 
data: my, 
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proc: Context.NopDestroyProc, 
window: w ! Context.Error = > CONTINUE); 


}; 


GetPreMargin: PUBLIC PROC [item: CvXIit.MessageKey) RETURNS [leads: CARDINAL] = { 
RETURN [g.leadslitem]]; 

}; 


— PROCEDURES 


Init: PROC = { 

z: UNCOUNTED ZONE = BWSZone.PermanentJ); 

g«-l 

leads: ALL[CARDINAL.I_AST], 
ctype: Context.UniqueType[], 
z: zl; 

MeasureTagsU; 

—/* register with converter icon */ 

Register!); 


MeasureTags: PROC = { 

Imarg: CARDINAL = CvXIit.leadingMargin; 
max: CARDINAL <— 0; 

—/* local proc */ 

Length: PROC [key: CvXIit.MessageKey] RETURNS [width: CARDINAL] = 

{ 

rb: XString.ReaderBody CvXlit.GetMessage[key]; 

(width: width] «-SimpleTextDisplay.MeasureString[string: @rbj; 
RETURN [width]; 

}; 


—/* begin code */ 

g.leads*- [ 

paraEndsWith: Length(paraEndsWithL 

fontSize: Length[fontSize], 

fontSizeChoices: 0, 

font: Lengthpfont], 

fontChoices: 0, 

ignoreTrailing: 1, —no tag 

lineLen; Length[lineLen], 

lineLenChoices: 0, 

charsSuffix: CARDINAL.LAST, 

wordwrap: CARDINAL.LAST, 

endLine: Length[endLine], 

endPara: Length[endPara], 

replaceUnknown: Length[replaceUnknown], 

transliterationTable: Length[transliterationTable], 

sparePI: 0, 

spareP2: 0, 

spareP3: 0, 

spareP4: 0, 

spareP5: 0, 

lastPsheetltem: 0]; 

—/* now determine max *7 

FOR i: CvXIit.MessageKey IN CvXlitMessageKey[paraEndsWith..tastPsheetltem] DO 
IF g,leads[i] = CARDI NAL. LAST THEN LOOP; 
max *-MAX[max,g.leads! i]]; 

END LOOP; 

—/* now adjust */ 

max *- max + Imarg; 

FOR i: CvXIit.MessageKey IN CvXIit.MessageKeyfparaEndsWith..lastPsheetltem] DO 
SELECTg.leads[i] FROM 
0 = > LOOP; 

1 = > g.leads[i] <—max-f 8; —compensate for no tag 
CARDINAL.LAST = > g.leads[i] *- CvXIit.pointsBetweenltems; 

ENDCASE — > g.leads[i] <— max - g.leads[i); 

ENDLOOP; 


RegisterNow: PROC [first: BOOLEAN] RETURNS [allOk: BOOLEAN*-TRUE] = { 

doc: XString.ReaderBody*— ConverterMsg.GetJConverterMsg.kvpDocument]; 
asciiDoc: XString.ReaderBody CvXlit.GetMessage[asciiDoc]; 
status: Converter.Status; 

—/* local proc *t 

Check: PROC [status: Converter.Status] = 

{ 

SELECT status FROM 

registered, alreadyExisted, overridden = > NULL; 
busy = > 

{ 

IF first THEN 

( 

et: Event.EventType «-Converter.GetEventType[]; 

—/* tell user registration wilt be done later *( 
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-F$$$ not implemented 


[]«- Event.AddDependency[ 
agent: RetryRegistration, 
myData: NIL, 
event: et]; 

firsts-FALSE; —/* only add once! */ 

}; 

allOk^e— FALSE; 

}; 

error = > allOk FALSE;-F$$$ should post a message 

ENDCASE; 


—/* begin code */ 

status Converter.Register! 
srclype: StarFileTypes.text, 
srcFormat: @asciiDoc, 
destFormat: @doc, 
convertProc: CvXiit.AsciiToVP, 
sizeChange: 190, 
forkable: TRUE].status; 

Check[status]; 

status «— Converter. Reg isterf 

srcType: StarFileTypes.unspecified, 
srcFormat: @asciiDoc, 
destFormat: @doc, 
convertProc: CvXfit.AsciiToVP, 
sizeChange: 190, 
forkable: TRUE].status; 

Checklstatus]; 

status *- Converter,Register] 

srcType: StarFileTypes.document, 
srcFormat: @doc, 
destFormat: @asciiDoc, 
convertProc: CvXIit.VPToAscii, 
sizeChange: 63, 
forkable: TRUEl.status; 

Check[statusj; 

—/* register ops *7 

IF NOT allOk THEN RETURN; 

status <r- Converter.DestinationOptions] 
srcFormat: @doc, 
destFormat: @asciiDoc, 
dependentOptions: CvXIit.VPToAsciiDstOps, 
override: TRUEl.status; 

Checklstatus]; 

status *r- Con verter.SourceOptions] 
srcFormat; @asciiDoc, 
destFormat: @doc, 

dependentOptions: CvXIit.AsciiToVPSrcOps, 
override: TRUEl.status; 

Checklstatus]; 

status Converter.DestinationOptionsl 
srcFormat: @asciiDoc, 
destFormat: @doc, 

dependentOptions: CvXlit.AsciiToVPDstOps, 
override: TRUEl.status; 

Checklstatus]; 


RetryRegistration: Event.AgentProcedure = { 

IF RegisterNowlfirst: FALSE].allOk THEN removeTRUE; 

); 


RetryProductFactoring: Event.AgentProcedure = { 

IF NOT ProductFactoring.Enabled[option: ConverterPFOptions.conASCII] THEN 

{ 

msg: XString.Readersody CvXlit.GetMessage[notPF]; 

Attention.Post[@msg]; 
remove «-FALSE; 

> 

ELSE 

{ 

Process. Detach[FORK Avoid Deadlock!]]; 
remove <-TRUE; 

}; 
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< < 


Avoid Deadlock 

* Finish doing registrations in another process, to make sure we don't try to AddDependency from inside of an AgentProcedure. 


AvoidDeacilock: PROC = { 

Process.PausefProcess.5econdsToTickst2]J; —/* give othe r process a chance */ 
[]«-RegisterNow]first: TRUE]; 

}; 


Register: PROCEDURE = { 

IF NOTProductFactoring.Enabled[option: ConverterPFOptions.conASCIIjTHEN 

{ 

msg: XString.ReaderBody CvXlit.QetMessage[notPF]; 

logon: Event.EventType *— Atom.MakeAtom["LogonCompleted"L]; 

Attention.Post[@msg]; 

(] <- Event.AddDependency[ 
agent: RetryProductFactoring, 
myData: NIL, 
event: logon]; 

> 

ELSE [] <- RegisterNowffirst: TRUE]; — OK 

}; 


—/* MAIN code */ 
InitU; 


END... 


LOG 

16-Mar-B7 14:06:16 - Caro - Created 

30-Juri-87 12:39:59 - Caro - MDS relief, RetryProductFactoring 
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— File: CvXIitMsgFilelmpl.mesa 

— Trow 7-Sep-89 16:40:41 

-- Last Revised by: Erickson 17-Dec-87 16:06:35 

— Owner: Workstation Applications - Foreign Conversion Team 

— Copyright <c) 1985, 1986,1987, 1988, 1989 by Xerox Corporation. All rights reserved. 

DIRECTORY 

ApplicationFolderExtra 
USING [InitMessages], 

CvXlit, 

NSFile 

USING [Error], 

Runtime 

USING [UnboundProcedure], 

XMessage 

USING [AllocateMessages,Get, Handle, MsgEntry, RegisterMessages], 

XString 

USING [FromSTRING, nullReaderBody, ReaderBody]; 

CvXIitMsgFilelmpI: PROGRAM 
IMPORTS 

ApplicationFolderExtra, NSFile, Runtime, XMessage, XString 
EXPORTS CvXlit = 

BEGIN 


— GLOBALS 


h: XMessage.Handle NIL; 


— SIGNALS 


NoMessageFile: ERROR = CODE; 


— PUBLIC PROCEDURES 


GetMessage: PUBLIC PROCEDURE [msg: CvXlit,MessageKey] RETURNS ImsgRb: XString,ReaderBody] = { 
IF h # NIL THEN RETURN[h.Get[m$g.ORD]]; 

RETURNlXString.nullReaderBody]; 

>; 


— PROCEDURES 


InitMessages: PROCEDURE = { 

iriternalName: XString.ReaderBody XString.FromSTRING]"FC Xlit Documents'^]; 
messageFile: XString.ReaderBody<^- XString.FromSTRING["MessageFiIe"L]; 

h *- ApplicationFolderExtra, lnitMessages[ 
internalName: @internaiName, 
label: @messageFile, 

domainindex: 0 ! ANY = > {h NIL; CONTINUE}]; 

IE h = NIL THEN 

InitFromArrayO; 

}; 


InitFromArray: PROC = { 

h «-XMe$sage.AllocateMessages["Xlit Conversion"L, CvXIit.MessageKey.LAST.ORD.SUCC, NIL, NIL]; 

Init0to20(]; 

lnit21toLAST[]; 


Init0to20: PROC = { 

msgArray: ARRAY CvXlit.MessageKey[asciiDoc..lastPsheetltem] OF XMessage.MsgEntry { 
asciiDoc: ( 

msg Key: CvXIit.MessageKey.asciiDoc.ORD, 
msg: XString. FromSTRING ["Transliterated Text"L], 
type: userMsg, 

translationNote: " Label for source or destination of conversion "L, 
translatable: FALSE, 
id: 0], 

paraEndsWith: [ 

msgKey: CvXIit.MessageKey.paraEndsWith.ORD, 
msg: XString.FromSTRING["Paragraph ends with"L], 
type; pSheetltem, 

translationNote: "Tag for text item, should read as if user were filling in the blank/completing the sentenced, 
translatable: TRUE, 
id: 1], 
fontSize: [ 

msgKey: CvXIit.MessageKey.fontSize.ORD, 
msg: XString. FromSTRING ["Font size"L], 
type: pSheetltem, 

translationNote: "Choice item tag"L, 
translatable: TRUE, 
id: 2], 

fontSizeChoices: [ 


CvXIitMsgFilelmpl.mesa 7-$ep-89 16:40:43 PDT 



















msgKey: CvXIit.MessageKey.fontSizeChoices.ORD, 
msg:XString.FromSTRINGr , 12:0@18:1@24:2"L], 
type: argList, 

translationNote: “Choices that go with id#2“L, 
translatable: FALSE, 
id: 31, 
font: 1 

msgKey: CvXIitMessageKey.font.ORD, 
msg: XString.FromSTRING["Font"L], 
type: pSheetltem, 

translationNote: “Choice itemtag"L, 
translatable: TRUE, 
id: 4], 

fontChoices: [ 

msgKey: CvXIit.MessageKey.fontChoices.ORD, 
msg: XStnng.FromSTRING["Modern:0@Classic:r‘L], 
type: argList, 

translationNote: "Choices that go with id#4"L, 
translatable: TRUE, 
id: 5), 

ignoreT railing: 1 

msgKey: CvXIit.MessageKey.ignoreTrailing.ORD, 
msg: XString.FromSTRING["IGNORE TRAILING WHITE SPACE"L], 
type: pSheetltem, 
translationNote: “8oolean item"L, 
translatable: TRUE, 
id: 6J, 
lineLen: [ 

msgKey: CvXIitMessageKey.lineLen.ORD, 
msg: XString.FromSTRING["Line length"L], 
type: pSheetltem, 

translationNote: "Choice itemtag"L, 
translatable: TRUE, 
id: 7], 

lineLenChoices: [ 

msgKey: CvXIitMessageKey.lineLenChoices.ORD, 
msg: XString.FromSTRING["Unlimited:Q@Limited: 1 “LI, 
type: argList, 

translationNote: "Choices that go with id#7"L, 
translatable: TRUE, 
id: 8}, 

charsSuffix: 1 

msg Key: CvXIit,M essageKey.charsSuffix.0RD, 
msg: XString.FromSTRING["character$"Ll, 
type: pSheetltem, 

translationNote: “Suffix for number item — to be read e.g, '[80] characters'"L, 
translatable: TRUE, 
id: 9), 

wordwrap: [ 

msg Key: CvXlit, M essageKey.wordWrap.ORD, 
msg :XString.FromSTRING[ r, WORD WRAP" L], 
type: pSheetltem, 

translationNote: "Boolean item, indicating that text lines should break only on the white space between words"L, 
translatable: TRUE, 
id: 10), 
endLine; [ 

msgKey: CvXIit.MessageKey.endLine.ORD, 
msg: XString.FromSTRING["End line with"L], 
type: pSheetltem, 

translationNote: “Text item tag, should read as if user is filling in the blank/completing sentenced, 
translatable: TRUE, 
id: 111, 
endPara: [ 

msgKey: CvXlit.MessageKey.endPara.ORD, 
msg: XString.FromSTRING["End paragraph with“L], 
type: pSheetltem, 

translationNote: "Text item tag, should read as if user is filling in the blank/completing sentenced, 
translatable: TRUE, 
id: 121, 

replaceUnknown: [ 

msgKey: CvXlitMessageKey.replaceUnknown.ORD, 

msg: XString.FromSTRING["Replace unknown characterwith"Ll, 

type: pSheetltem, 

translationNote: "Text item tag, should read as if user is filling in the blank/completing sentence"L, 
translatable: TRUE, 
id: 13], 

transliterationTabie: ( 

msgKey: CvXIit.MessageKey.transliterationTable.ORD, 
msg: XString.FromSTRING["Tran$literation table"L], 
type: pSheetltem, 

translationNote: "Choice item tag"L, 
translatable: TRUE, 
id: 141, 
sparePI:[ 

msgKey: CvXlit. MessageKey.sparePI ORD, 
msg: XString.FromSTRINGr"'L], 
type: others, 

translationNote; "DO NOT TRANSLATE — spare key"L, 
translatable: TRUE, 
id; 151. 
spareP2: [ 

msgKey: CvXlit.MessageKey,spareP2.0RD, 
msg: XString.FromSTRING[""L], 
type: others, 

translationNote: "DO NOT TRANSLATE—spare key"L, 
translatable: TRUE, 
id: 161, 
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spareP3: [ 

msgKey: CvXlit.MessageKey.spareP3.0RD, 
msg; XString.FromSTRING| ,,,, L], 
type: others, 

translationNote: "DO NOT TRANSLATE — spare key"L, 
translatable: TRUE, 
id: 17], 
spareP4:[ 

msgKey: CvXlit.MessageKey.spareP4.0RD, 
msg: X5tring.FromSTRING[""Lj, 
type: others, 

translationNote: "DO NOTTRANSLATE— spare key"L, 
translatable: TRUE, 
id: 18], 
spareP5:( 

msgKey: CvXlit.MessageKey.spareP5.0RD, 
msg: XString.FromSTRING[ ,,,, L], 
type: others, 

translationNote: "DO NOTTRANSLATE — spare key"l, 
translatable: TRUE, 
id: 19], 

lastPsheetltem: [ 

msgKey: CvXIit.MessageKey.lastPsheetitem.ORD, 
msg: XString.FromSTRING[""L], 
type: others, 

translationNote: "DO NOTTRANSLATE — sparekey"L, 
translatable: TRUE, 
id: 20] 

); 

XMessage.RegisterMessages[h, LOOPHOLE [LONG [DESCRIPTOR[msgArray]]], FALSE]; 


lnit211:oLAST: PROC = { 

msg Array: ARRAY CvXlit.MessageKey[left..CvXlit.MessageKey.LAST] OF XMessage.MsgEntry <- [ 
left: [ 

msgKey: CvXI it. Message Key, left. ORD, 
msg: XString.FromSTRING["<"L], 
type: others, 

translationNote: “do not translated, 
translatable: FALSE, 
id: 21], 
right: [ 

msgKey: CvXlit.MessageKey.right.ORD, 
msg: XString,FromSTRING[" >d], 
type: others, 

translationNote: "do not translated, 
translatable: FALSE, 
id: 22], 
cr: [ 

msgKey: CvXIit.MessageKey.cr.ORD, 
msg: XString.FromSTRING["CR"L], 
type: others, 

translationNote: "do not translate"L, 
translatable: FALSE, 
id: 23], 

If: l 

msgKey: CvXlit.MessageKey.lf.ORD, 
msg: XString.FromSTRING["LF"L], 
type: others, 

translationNote: "do not translate“L, 
translatable: FALSE, 
id: 24], 
nl: [ 

msgKey: CvXlit.MessageKey.nl.ORD, 
msg: XString.FromSTRING["NL"L], 
type: others, 

translationNote: "do not translate"L, 
translatable: FALSE, 
id: 25], 
ff:[ 

msgKey: CvXIit.MessageKey.ff.ORD, 
msg: XString.FromSTRING["FrL], 
type: others, 

translationNote: "do not translated, 
translatable: FALSE, 
id: 26], 
tab: [ 

msgKey: CvXIit.MessageKey.tab.ORD, 
msg: XString.FromSTRING["TAB"L], 
type: others, 

translationNote: "do not translated, 
translatable: FALSE, 
id: 27], 
createError: [ 

msgKey: CvXIit.MessageKey.createError.ORD, 

msg: XString.FromSTRING["The source object was not converted due to an error while creating the output file. "L], 
type: errorMsg, 

translationNote: "Posted to attention window"L, 
translatable: TRUE, 
id: 281, 
notPF: [ 

msgKey: CvXIit.MessageKey.notPF.ORD, 

msg; XString.FromSTRING["Transliterated Text Conversion cannot be activated because required Software Option not enabled. Please 
enable Software Option, End Session, then Logon again."L], 
type: errorMsg, 
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translationNote: "posted to attention window"!., 
translatable: TRUE, 
id; 29], 
paginating: ( 

msgKey; CvXIit.MessageKey.paginating.ORD, 
msg: XString.FromSTRING(" paginating ... “L], 
type: userMsg, 

translationNote: "posted to attention window following 'Converting xyz ... 'converter icon message. The leading and trailing 
spaces are REQUIRED"!., 
translatable: TRUE, 
id: 30], 

skippedTableData: [ 

msgKey: CvXIit.MessageKey.skippedTableData.ORD, 

msg: XString-FromSTRINGl" Some data in 'o'was skipped ... "L], 

type: template, 

translationNote: "Some table data skipped. Leading and trailing blanks REQUIRED."L, 
translatable: TRUE, 
id: 31], 

dfltAVEndParagraph: [ 

msgKey: CvXIitMessageKey.dfltAVEndParagraph.ORD, 
msg: XString.FromSTRiNGl" <CR><CR>"L], 
type: others, 

translationNote: "do not translate, default value for text items"L, 
translatable: FALSE, 
id: 32], 

dfltAVReplaceCharacter: ] 

msgKey: CvXIit.MessageKey.dfltAVReplaceCharacter.ORD, 
msg: XString.FromSTRINGI"$"L], 
type: others, 

translationNote: "do not translate, default value for text items"L, 
translatable: FALSE, 
id: 33], 
prefix: [ 

msgKey: CvXIit.MessageKey.prefix.ORD, 
msg: XString.FromSTRING["CvXlit"L], 
type: others, 

translationNote: "do not translate, internal file name prefix"L, 
translatable: FALSE, 
id: 34], 
doneFailed: [ 

msgKey: CvXIit.MessageKey.doneFailed.ORD, 

msg: XString.FromSTRING]"Unrecoverable error writing Transliterated Text conversion properties. Cancel the property sheet and 
use a new converter icon."L], 
type: errorMsg, 

translationNote: "Posted when user selects Done on property sheet, if there isan NSFile or other error"L, 
translatable: TRUE, 
id: 35], 
backstop: [ 

msgKey: CvXIit.MessageKey.backstop.ORD, 

msg: XString.FromSTRtNG["Probiem: the details section could not be created." L], 
type: pSheetltem, 

translationNote: "For some reason, creation of the client details window failed. This string is put in theformwindow 
instead."L, 
translatable: TRUE, 
id: 36], 
metaError: [ 

msgKey: CvXIit.MessageKey.metaError.ORD, 

msg: XString.FromSTRING[ M The selected text item contains an error. Please correct it."L], 
type: errorMsg, 

translationNote: "This message is posted to the Attention window when the user tries to Done or Start a sheet with a text/syntax 
error. Text syntax is described in the Reference Library documentation for ASCII."L, 
translatable: TRUE, 
id: 37], 

charsOutOfBounds: [ 

msgKey: CvXIit.MessageKey.charsOutOfBounds.ORD, 

msg: XString.FromSTRING["The line length limit must be between 10 and 256 characters, inclusive. Please reenter,"L], 
type: errorMsg, 

translationNote: "Posted when usertriesto Done orStarta sheet with an invalid numeric value."L, 
translatable: TRUE, 
id: 38], 
fatalError: [ 

msgKey: CvXIit.MessageKey.fatalError.ORD, 

msg: XString.FromSTRINGt" conversion failed with an unrecoverable error "LJ, 
type: errorMsg, 

translationNote: "Posted if NSFiie or other error in conversion. Note that leading and trailing blanks a re required. "L, 
translatable: TRUE, 
id: 39], 
extraErrO: l 

msgKey: CvXIit.MessageKey.extraErrO.ORD, 

msg: XString.FromSTRING[" Unrecoverable Transliterated Text conversion error: damaged converter icon. "L], 
type: errorMsg, 

translationNote: "Blanks are required. Posted if the conversion cannot read properties from the converter icon."L, 
translatable: TRUE, 
id: 40], 
extraErrl: ( 

msgKey: CvXIit.MessageKey.extraErrl.ORD, 

msg: XString.FromSTRING["The number in the highlighted field is invalid. Please reenter."L], 
type: errorMsg, 

translationNote: "Posted when the usertries to Done or Start a sheet with text in a numeric field. "L, 
translatable: TRUE, 
id: 41], 

dfltVAEndLine: ( 

msgKey: CvXIit.MessageKey.dfltVAEndLine.ORD, 
msg: XString.FromSTRiNGl" <CR>"L], 
type: others, 

translationNote: "do not translate, default value for text items‘‘L, 
translatable: FALSE, 
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id: 42], 

dfltVAEndParagraph: l 

msgKey: CvXIit.MessageKey.dfltVAEndParagraph.ORD, 
msg: XString,FromSTRINGr'<CR> "L], 
type: others, 

translationNote: "do not translate, default value for text items”L, 
translatable: FALSE, 
id: 43], 

dfltVAReplaceCharacter: [ 

msgKey: CvXIit.MessageKey.dfltVAReplaceCharacter.ORD, 
msg: XString.FromSTRING[ M $"L], 
type: others, 

translationNote: "do not translate, default value for text items"L, 
translatable: FALSE, 
id: 44] 


< < 

«»: [ 

msgKey: CvXIit.MessageKey.USEAGAINTOREPLACETHISSTRING.ORD, 
msg: XString.FromSTRING]"«»"L} > 
type: «», 

translationNote: "«»"L, 
translatable: TRUE, 
id: «»], 

> > 

]; 


XMessage.RegisterMessages(h, LOOPHOLE[LONG[DESCRIPTOR[m$gArray]]], FALSE]; 

}; 


—/* MAIN line code *7 

InitMessages]! NSFile.Error, Runtime.UnboundProcedure => NoMessageFile]; 
END... 


LOG 

24-Apr-85 12:12:27 - MSchneider - CREATED from SampleBWSApplicationMsgFilelmpI 
10-May-85 10:56:18 - MSchneider - used correct ApplicationFolder name 
28-May-85 9:28:54 - MSchneider - moved locaIZone into procedure, added use of BWSZone 
24-lun-85 14:33:55 - MSchneider - made "MessageFile" be "MessageFile" in entry name 
9-Jul-85 11:12:31 - MSchneider - added ERROR NoMessageFile 
26-Feb-87 14:59:12 - Caro - Upgraded to VP 2.0 (delete 90% of code) 

8-Apr-87 11:43:56 - Caro - Catch ANY error raised from InitMessages 
26-Jun-87 11:10:51 -Caro - Made #44a real error 
19-Aug-87 10:51:37 - Caro - Reworded several messages and transNotes 

24-Nov-87 17:01:04- Erickson - added aToVDfltMeta (ID = 46) to change default for ascii to Viewpoint treatment of paraEndsWith. 
17-De<:-87 16:04:02 - Erickson - AR 16414 - made #45 a real error, bad number input. 
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— File: CvXIitParselmpl.mesa 

— Trow 17-Aug-89 4:48:30 

— Last Revised by: Caro 29-Jun-87 11:31:40 

— Owner: Workstation Applications - Foreign Conversion Team 

— Copyright (c) 1987, 1989 by Xerox Corporation. All rights reserved. 

DIRECTORY 

Ascii 

USING [CR, FF, LF, TAB], 

Attention 

USING [PostJ, 

CvXlit 

USING (Common, GetMessage, MessageKeyl, 

ForrnWindow 

USING [SetSelection, SetlnputFocusJ, 

String 

USING [AppendChar, CopyToNewString, MakeString, StringBoundsFauIt], 
XChar 

USING (Character, Code, not], 

XString 

USING [AppendChar, ClearWriter, CopyToNewReaderBody, 

Empty, Equal, First, FromSTRING, FreeReaderBytes, FreeWriterBytes, 

IrivalidEncoding, Lop, NewWriterBody, 

Reader, ReaderBody, ReaderFromWriter, ValidateReader, Writer, Writers odyj; 


< < 

— OVERVIEW: 

Parse text items containing meta characters into strings. 


> > 


CvXIitParselrnpl: PROGRAM 
IMPORTS 

Attention, CvXlit, FormWindow, String, XChar, XString 
EXPORTS 
CvXlit = 

8EGIN 


— CONSTANTS 


max: CARDINAL = 10; 

maxAbbr: CARDINAL = 3; —/* abbreviations only up to 3 characters */ 
maxOctals: CARDINAL = 3; —/* need exactly 3 octal digits *7 


ParseStates: TYPE = { 
entry, 
beginMeta, 
doOctal, 
do Abb rev 

K 


— SIGNALS 


ParseError: SIGNAL [err: ErrType *-$yntaxError, start, pos: CARDINAL] = CODE; 

ErrType: TYPE = 

{ 

syntaxError, 
invalidMeta, 
unknown Abbr, 
invalidOctal, 
invalidEncoding 
}; 


— PUBLIC PROCEDURES 


Parseltem: PUBLIC PROC [my: CvXIit.Common, r: XString.Reader, item: CvXIit.MessageKey, buf: XString .Writer*-NIL] RETURNS [ok: BOOLEAN, 
Is: LONG STRING] = { 

bufRb: XString.WriterBody; 
tmpRb: XString.ReaderBody; 
msgRb: XString.ReaderBody; 
clientBuf: BOOLEAN; 

IF buf = NILTHEN 

{ 

bufRb ^-XString.NewWriterBody[maxLength: 30, z: my.z]; 
buf <-@bufRb; 
clientBuf *- FALSE; 

} 

ELSE 

clientBuf*-TRUE; 

BEGIN 

ENABLE ParseError = > 
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{ 

msgRb <^-CvXlit.GetMessage[metaError]; 

IF my.window = NIL OR item = CvXIit.MessageKey.FIRST THEN GOTO notOK; 

FormWindow.SetSelection( 
window: my.window, 
item: item.ORD, 
firstChar: start, 
lastChar: pos]; 

FormWindow.SetlnputFocus[ 
window: my.window, 
item: item.ORD, 
beforeChar: pos]; 

Attention.Post[@msg Rb] ; 

Is «- NIL; 

GOTO notOK; 

}; 


tmpRb <-XString.CopyToNewReaderBody]r: r,z: my.zj; 
ls«-ParseToLS(text: @trnpRb, z: my.z, buf: buf]; 


—/* test for invalid encoding */ 

IF my.owner = AtoVdst THEN 

{ 

msgRb*-XString.FromSTRING[lsJ; 

XString.ValidateReader(@msgRb ! XString.InvalidEncoding 
SIGNAL ParseErrorl 
err: invalidEncoding, 
start: 0, 

pos: CARDINAL LAST]]; 

}; 


= > 


ok «-TRUE; 

EXITS notOK = > ok «- FALSE; 

END; 

IF NOT clientBuf THEN 

XString.FreeWriterBytes(buf]; 

XString.FreeReaderBytes[r: (SftmpRb, z: my.z]; 


— PROCEDURES 


ParseToLS: PROC [text: XString.Reader, z: UNCOUNTED ZONE, buf: XString.Writerl RETURNS [Is: LONG STRING NIL] = { 
rb: XString. ReaderBody*- CvXlit.GetMessage|left]; 
state: ParseStates*- entry; 
start, 

pos: CARDINAL*- 0; 
octals, 

abbrs: CARDINAL *-0; 
cr: XString.ReaderBody; 

If: XString.ReaderBody; 
nl: XString.ReaderBody; 
ff: XString.ReaderBody; 
tab: XString.ReaderBody; 
left: XChar.Character; 
right: XChar.Character; 
xc: XChar.Character; 
c: CHARACTER; 

cictalValue: CARDINAL10..255]; 

—/*get < and > */ 
left *- XString.First[@rb]; 
rb *—CvXlit,GetMe$$age[right]; 
right *— XString. First[@rb]; 


—/* initialize strings */ 

IF XString.Empty[text] THEN 
RETURN[ls: NIL] 

ELSE 

Is *-String.MakeStringtz: z, maxlength: max]; 
cr *- CvXIit.GetM essag e[cr]; 

If *- CvXlit.GetMessage[lf] ; 
ril «—CvXlit.GetMessage[n!]; 
ff *- CvXIitGetMessagefff]; 
tab *-CvXIit.GetM essag e[tab]; 

—/* lop through string */ 

DO 

ENABLE 

{ 

String.StringBoundsFault => 

{ 

ns*-String.CopyToNewString[s: Is, z: z, longer: max]; 
z.FREEl@ls]; 

Is<- ns; 

RESUME [ns]; 

}; 

UNWIND => 

{ 

IF Is # Nil THEN z.FREEl@ls]; 

}: 

>; 
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xc <- XString.Lopltext]; 

IF xc = XChar.not THEN 

{ 

IF state = entry THEN 
EXIT 

ELSE 

SIGNAL ParseError[err: syntaxError, start; start, pos: pos]; 


SELECT state FROM 
entry = > 

{ 

IF xc = left THEN 

state «- beg inM eta 

ELSE 

{ 

c <- LOOPHOLE[XChar.Code(xc], CHARACTER]; —/* only Charset 0 */ 
String,AppendChar[s: Is, c: cj; 
state <- entry; 

}; 

pos «- pos + 1 ; 

I; 

beginMeta = > 

{ 

start *— pos; 

C «- LOOPHOLE[XChar.Code[xcL CHARACTER]; —/* only Charset 0 */ 
SELECT c FROM 
IN ro.,'3] => 

{ 

state-e-doOctal; 
octals*- 1; 
octalValue*-c-'0; 

}; 

'C, 'F/L/N.'T,'< => 

t 

state *- doAbbrev; 

XString.ClearWriter[buf]; —/* collect abbreviation here */ 
XString.AppendChar(to: buf,c: xc]; 
abbrs*- 1; 

}; 

ENDCASE => 

SIGNAL ParseError[err: invalidMeta, start: start, pos: pos]; 
pos pos + 1; 

}; 

doOctal = > 

{ 

c «- LOOPHOLE[XChar.Code[xc], CHARACTER]; —/* only Charset 0 */ 

IF xc = right THEN 

{ 

IF Start = posTHEN 

SIGNAL ParseErrorferr: invalidMeta, start: start, pos: pos -f 1]; 
IFoctals< maxOctalsOR octalValue > 377BTHEN 

SIGNAL Parse£rror[err: invalidOctal, start: start, pos: pos]; 
c<- LOOPHOLE[octalValue, CHARACTER]; 

String.AppendChar[s: Is, c: c]; 
state *-entry; 

} 

ELSE IF octals > = maxOctals THEN 

SIGNAL ParseErrorferr: invalidOctal, start: start, pos: pos] 

ELSE IF NOT c IN ['0..'7]THEN 

SIGNAL ParseError[err: invalidOctal, start: start, pos: pos] 

ELSE 

{ 

octalValue ♦-(octalValue * 8) + (c - '0); 
octals *- octals + t; 
state «-doOctal; 

}; 

pos <- pos + 1 ; 

}; 

doAbbrev = > 

{ 

IF xc = right THEN 

{ 

tmp: XString .Reader *-XString.ReaderFromWriter(buf]; 

IF start = posTHEN 

SIGNAL ParseErrorferr: invalidMeta, start: start, pos: pos + 1]; 
IFabbrs > maxAbbrTHEN 

SIGNAL ParseError[err: unknownAbbr, start: start, pos: pos]; 
SELECT TRUE FROM 

XString.Equal[r1: tmp, r2: @cr] => 

String.AppendChar[s: ls,c: Ascii.CR]; 

XString.Equaljrl: tmp, r2: @lf] = > 

String.AppendChar[s: ls,c: Ascii.LF]; 

XString.Equal[r1: tmp, r2: @nl] = > 

{ 

String.AppendCharJs: Is, c: Ascii.CR]; 

String.AppendChar]s: Is, c: Ascii.LF]; 

}; 

XString.Equal[r1; tmp, r2: @tab] => 

String.AppendChar|s: Is, c: Ascii.TAB]; 

XString.Equal[r1: tmp, r2: @ff] = > 

String,AppendChar{s: ls,c: Ascii.FF]; 
abbrs = 1 AND c = '< = > 

String,AppendChar]s: ls,c:'<]; 

ENDCASE => 

SIGNAL ParseError[err: unknownAbbr, start: start, pos: pos]; 
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state <-entry; 

} 

ELSE 

{ 

XString.AppendCharfto: buf.c: xc]; 
abbrs*-abbrs + 1; 
state <—doAbbrev; 

}; 

pos *r- pos + 1; 

k 

ENDCASE; 

ENDLOOP; 

}; 


END.,. 


LOG 

16-Mar-87 14:06:16 - Caro - Created 

26-Jun-87 11:28:54 - Caro - Added test for MessageKey.FIRST to Parseitem 
29-Jun-87 11:33:00 - Caro - Added validation to Parseitem 
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•— File; CvXIitToVPImpl.mesa 

— Trow 7-Sep-89 16:59:04 

— Last Revised by: Shinsato 12-Feb-88 13:00:11 

— Owner: Workstation Applications - Foreign Conversion Team 

— Copyright(c) 1987, 1988, 1989 by Xerox Corporation. All rights reserved 

DIRECTORY 

Ascii 

USING [CR.FF, LF.NUL, SP, TAB I, 

Backg roundProcess 

USING [ResetUserAbort, UserAbort], 

BWSZone 

USING [Permanent], 

Converter 

USING [ConvertProc, CvData, DependentOptionProc, GetPOption, PostMessage], 
CoriverterMsg, 

CvXlit, 

DodnterchangeDefs 

USING (AppendNewParagraph, AppendPageBreak, AppendText, CheckAbortProc, 
Doc, Error, FinishCreation, FinishCreationStatus, 

PaginateOption, StartCreation, StartCreationStatus], 

DocInterchangePropsDefs 

USING [Family, FontPropsRecord, GetFontPropsDefaults, GetPagePropsDefaults, 
GetParaPropsDefaults, PagePropsRecord, ParaPropsRecord, modern, classic]. 
Environment 

USING [Block, Byte, bytesPerPage, wordsPerPage), 

NSFile 

USING [Close, Error, GetReference, Handle, Logoff, 
nullHandle, OpenByReference, Reference, Session], 

NSFileStream 

USING [Create, Handle], 

Space 

USING [ScratchMap, Unmap], 

Stream 

USING [CompletionCode, Delete, GetBlock], 

TIP 

USING [ResetUserAbort, UserAbort], 

XCharSetO 
USING [Make], 

XString 

USING [AppendChar, ByteLength, 

Character, CharacterLength, ClearWriter, FreeWriterBytes, 

InvaltdEncoding, NewWriterBody, Reader, ReaderBody, ReaderFromWriter, 

Writer, WriterBody, Writerlnfo]; 


— OVERVIEW: 

XIit to VP conversion. 


> > 

CvXlitToVPImpl: PROGRAM 
IMPORTS 

BackgroundProcess, BWSZone, Converter, ConverterMsg, CvXlit, 
DodnterchangeDefs, DocInterchangePropsDefs, 

NSFile, NSFileStream, Space, Stream, TIP, 

XCharSetO, XString 
EXPORTS 
CvXlit = 

BEGIN 


— CONSTANTS 


maxPara: CARDINAL = 8 * 1024; 

buf Pages: CARDINAL = (maxPara + Environment.bytesPerPage - 1) / Environment.bytesPerPage; 
paraLen: CARDINAL = maxPara/4; 

words: CARDINAL = SIZE[CtoVPCharMap]; 

stopsAt: CARDINAL = 5; —/* tab stops every five characters */ 
tabStopCount: CARDINAL = (132/stopsAt)+1; --/* 132 columns max */ 

a Hyphen: CHARACTER = 055C; 

xNewUne: XString.Character = XCharSetO.MakeJnewLine]; 


— TYPES 


AVData: TYPE = LONG POINTER TO AVDataObj; 

AVDataObj: TYPE = RECORD [ 
source: NSFile.Handle, 

input; NSFileStream. Handle, —/* created from source */ 
cvData: Converter.CvData, 
session: NSFile.Session, 

src: CvXIit.Common, —/* common data distinguished by owning formwindow */ 
cist: CvXIit.Common, 
background: BOOLEAN, 

fontProps: DocInterchangePropsDefs.FontPropsRecord, 
paraProps: DocInterchangePropsDefs.ParaPropsRecord, 
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pageProps: DocInterchangePropsDefs.PagePropsRecord, 
doc: DodnterchangeDefs.DOC, 

blk: Environment.Block, —/* primary input buffer *7 
state: AVState, 
z: UNCOUNTED ZONE]; 

—/* the various states of the StateMachine */ 

AVState: TYPE = 

{ 

entry, 

append, 

ignoreTrailing, 

maxExceeded, 

endPara 

}; 


CtoVPCharMap: TYPE = ARRAY CHARACTER OF XString.Character; 


— GLOBALS 


Global: TYPE = RECORD [ 

isomap: LONG POINTER TO CtoVPCharMap, 
modmap: LONG POINTER TO CtoVPCharMap, 
pz: UNCOUNTED ZONE]; 

g: Global; 


— PUBLIC PROCEDURES 


AsciiToVP; PUBLIC Converter.ConvertProc - { 

<< = PROCEDURE [source: NSFile.Handle, cvData: Converter.CvData, session: NSFile.Session, srclnstance: LONG POINTER NIL, dstlnstance: 
LONG POINTER <—NIL, background: BOOLEAN <- FALSE] RETURNS [dest: NSFile.Handle LOOPHOLE[0|1; 

> > 

ENABLE CvXIitProblem, NSFile.Error, XString.InvalidEncoding = > 

{ 

msgRb: XString.ReaderBody <— CvXlit.GetMessageffatalError]; 

Post[msgRb, cvData]; 

CONTINUE; 

}; 


IF source = NSFile.nullHandle THEN RETURN, 

dest <^AtoV[source, cvData, session, srclnstance, dstlnstance, background]; 


< <: 

Both DependentOptionProcs create instance data with CreateCommon. The data is distinguished by the owner variable. The CommonObj within 
CvXIit.CommonData is the data structure written to the client file stored as the icon properties. Only those fields pertaining to the 
owner are used. 


AsciiToVPSrcOps: PUBLIC Converter.DependentOptionProc = { 

< < = PROCEDURE [options: BOOLEAN <— TRUE, cvData: Converter.CvData, which: Converter.FormatToUse, srcFormat: XString.Reader, destFormat: 
XString.Reader, window: Window.Handle, oldlnstance: LONG POINTER NIL] RETURNS (menultemProc: Converter.MenuitemProc, destroy: 
Converter.DestroyProc, instance: LONG POINTER]; 

> > 

owner: CvXIit.Owners AtoVsrc; 

menultemProc CvXiitCommonMenu; 
destroy«— CvXIit.DestroyCommon; 

IF oldlnstance = NIL THEN 

instance «~CvXlit,CreateCommon[cvData, options, window, owner! NSFile.Error,CvXIitProblem = > {owners- backstop; instance «— 

NIL; CONTINUE}] 

ELSE 

{ 

my: CvXHt.Common oldlnstance; 

my.window-*—window; —/* AR 13535: update window handle */ 
instance my; 

}; 

—/* rnakeformwindow */ 

CvXIit.CreateFWlinstance, window, owner]; 

}; 


AsciiToVPDstOps: PUBLIC Converter.DependentOptionProc = { 

< < = PROCEDURE [options: BOOLEAN <r-TRUE, cvData: Converter.CvData, which: Converter.FormatToUse, srcFormat: XString.Reader, destFormat: 
XString.Reader, window: Window.Handle, oldlnstance: LONG POINTER •«— NIL] RETURNS [menultemProc: Converter.MenuitemProc, destroy: 
Converter.DestroyProc, instance: LONG POINTER]; 

> > 

owner: CvXIit.Owners <- AtoVdst; 
my: CvXIit.Common; 

menultemProc «-CvXlit.CommonMenu; 
destroy <- CvXIit.DestroyCommon; 

IF oldlnstance = NIL THEN 

{ 

instance CvXlit.CreateCommon[cvData, options, window, owner! 

NSFile.Error, CvXIitProblem => {owner backstop; instance NIL; CONTINUE}]; 

} 


CvXIitToVPImpl.mesa 7-Sep-89 16.59:06 PDT 


2 














ELSE 

{ 

my«-oidlnstance; 

my.window*- window; —/* AR 13535: update window handle */ 
instance my; 

}; 


—/* make formwindow *7 
C vXiit. Create FW[instance, window, owner]; 


GetAVTable: PUBLIC PROC RETURNS lavTable: LONG POINTER TO CtoVPCharMap] = { 
RETURNlg.modmap]; 

}; 


— PROCEDURES 


AtoV: Converter.ConvertProc = { 
aborted: BOOLEAN«— FALSE; 

start: DocInterchangeDefs.StartCreationStatus-e- lastAvailable; 
finish: DodnterchangeDefs.FinishCreationStatus *-lastAvaiiable; 
avData: AVDataObj; 

pOption: DocInterchangeDefs.PaginateOption; 

docSession; NSFile.Session; 

dst, 

src: CvXIit.Common«- NIL; 

lineHtlnPoints: CARDINAL <^-24; — lotsof space forXIit 
—/* local proc */ 

POption: PROCEDURE RETURNS [DocInterchangeDefs.PaginateOption] = INLINE 

{ 

SELECTConverter.GetPOption[] FROM 
compress = > RETURN[compress]; 
simple => RETURN(simpleJ; 
none => RETURNfnone]; 

ENDCASE = > ERROR; 

}; 


—/* begin code */ 

— I* initialize instance data *1 

IF dstlnstance = NIL THEN —/* ASSERT: srdnstance also NIL */ 

{ 

ENABLE NSFile.Error, CvXIit.Problem => 

{ 

msgRb: XString.ReaderBody«-CvXlit.GetMessage[extra£rr01; —" Unrecoverable Xlit conversion error: damaged converter icon. 
Converter.PostMessage[ 
msg: @msgRb, 
cvData: cvData, 
cr: FALSE, 
clear: FALSE]; 

IF src # NIL THEN CvXIit.DestroyCommonfsrc]; 

GOTO terminate; 

}; 

key: CvXlit.MessageKey«-CvXlit.MessageKey.FIRST; 

—/* assume both are NIL */ 

src«-CvXlit.CreateCommon(cvData, FALSE, NIL, AtoVsrc]; 
dst «-CvXlit.CreateCommon[cvData, FALSE, NIL, AtoVdst]; 

src.textlparaEndsWith] <-CvXlit,Parseltem[ 
my; src, 

r: @src.textRb[paraEndsWith], 
item: key].Is; 

dst.taxt(atovReplaceUnknown] <- CvXIit.ParseltemC 
my: dst, 

r: @dst.textRb(atovReplaceUnknown], 
item: key].Is; 

EXITS terminate => RETURN; 

} 

ELSE 

{ 

src srdnstance; 
dst <r- dstlnstance; 

}; 


avData [ 

source: source, 
input; (NIL], 
cvData: cvData, 
session: session, 
src: src, 
dst: dst, 

background: background, 
fontProps: TRASH, 
paraProps: TRASH, 
pageProps: TRASH, 
doc: TRASH, 

blk: [Space.ScratchMap(count: bufPages], 0, maxPara], 
state: entry, 
z: dst.z]; 


BEGIN 

ENABLE 
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{ 

DodnterchangeDefs.Error = > GOTO err; 

UNWIND = > 

{ 

avData.blk.blockPointer*- Space.Unmap[pointer: avData.blk.blockPointer]; 
IF srclnstance = Nil THEN CvXlit.De$troyCommon[src]; 

IFdstlnstance = NIL THEN CvXlit.DestroyCommon[dst]; 
src«-dst<— NIL; 

}; 


—/* open stream on source */ 
avData.input «- NSFileStream.Create! 
file: avData.source, 
closeOnDelete: FALSE, 

session: avData.session ! NSFile.Error = > {avData,input«- [NIL]; GOTO err}-]; 

—/* initialize */ 
pOption «- POptionfl; 

DocInterchangePropsDefs.GetFontPropsDefaultsI@avData.fontProps]; 

DodnterchangePropsDefs.GetParaPropsDefaults!@avData.paraProps]; 

DoclnterchangePropsDefs.GetPagePropsDefaultsI@avData.pageProps]; 

—/* apply initial parms */ 

SELECT avData.dst.f.font FROM 

CvXIit.modern = > avData.fontProps.fontDesc.family DocInterchangePropsDefs.modern; 
CvXIit.classic => avData.fontProps.fontDesc.family «- DodnterchangePropsDefs.classic; 
ENDCASE; 


SELECT avData.dst.f.fontSize FROM 
CvXIit.twelve = > 


{ 

avData.fontProps.fontDesc.pointSize 12; 

avData.paraProps.basicProps.lineHeight <r- MneHtlnPoints 32; 

avData.paraProps.basicProps.defauItTabStopSpacing ^-(stopsAt * 12); 

}; 

CvXIit.eightteen => 

{ 

avData.fontProps.fontDesc.pointSize 18; 
avData.paraProps.basicProps.lineHeight lineHtlnPoints«- 44; 
avData.paraProps.basicProps.defauItTabStopSpacing <-(stopsAt * 18); 
}; 

CvXIit.twentyFour — > 


avData .fontProps.fontDesc.pointSize24; 

avData.paraProps.basicProps.lineHeight lineHtlnPoints «- 64; 

avData.paraProps.basicProps.defauItTabStopSpacing <r-(stopsAt * 24); 


ENDCAS E;- 




— I* set paragraph properties for Xlit */ 
avData.paraProps.basicProps.streakSuccession «h- rightToLeft; 
avData.paraProps.basicProps.paraAlignment right; 


--/* set" 


•String *1 


BEGIN 

Icount: CARDINAL 4-0; 

eop: LONG STRING avData.src.text(paraEndsWith], 

IF eop # NIL THEN 

FOR i: CARDINAL IN (O..eop.length) DO 

IF eop[i] = Ascii.CR THEN Icount Icount 4- 1 ; 

ENDLOOP; 

—/* Icount = 0 = > default */ 

—/* Icount = 1 = > single spacing */ 

—/* Icount = 2 = > 1.5, etc. */ 

IF Icount > 1 THEN 

avData.paraProps.basicProps.postleading «- lineHtlnPoints * (Icount - 1) / 2; 


END; 


—/* StartCreation checks process priority to determine forkedness *1 
[doc: avData.doc, status: start] <- DocInterchangeDefs.StartCreation! 
paginateOption: pOption, 
initialFontProps: @avData.fontProps, 
initialParaProps: @avData.paraProp$, 
initialPageProps; @avData.pageProps I NSFile.Error = > { 

IF error = [space(mediumFull]] THEN 
start <- notEnoughDiskSpace 
ELSE 

start <-lastAvaiiable; 

CONTINUE}]; 

SELECT start FROM 
ok => NULL; 
notEnoughDiskSpace = > 

{ 

Post[ConverterMsg.Get[ConverterMsg,koutOfSpace], avData.cvData]; 

GOTO err; 

}; 

ENDCASE => 

{ 

Post[ConverterMsg.Get[ConverterMsg.kunknownProblem], avData.cvData]; 
GOTO err; 

}; 


—/* enter state graph */ 

BEGIN 

ENABLE ABORTED = > (aborted <-TRlJE; CONTINUE}; 
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StateMachine[@avData]; 

END; 

—/* paginating */ 

IF pOption # none THEN 

{ 

mrb: XString.ReaderBody-*-CvXlit.GetMessage[paginatingj; 

Converter, PostM essage[ 
msg: ©mrb, 
cvData: cvData, 
cr: FALSE, 
clear: FALSE]; 

}; 


—/* user may have partial doc after an abort, so allow paginate/finish *7 
—/* reset abort tests. User must abort paginate separately. */ 

IF aborted THEN 

{ 

IF avData.background THEN 

BackgroundProcess.ResetUserAbort|] 

ELSE 

TIP.ResetUserAbort[NlL]; 

}; 


—/* paginate and finish */ 

[docFile: dest, session: docSession, status: finish] *- DoclnterchangeDefs,FinishCreation{ 
docPtr: @avData.doc, 
checkAbortProc: UserAbortsPaginate, 
checkAbortClientData: @avData]; 

IF finish = aborted THEN 

{ 

aborted TRUE; 

Post[ConverterMsg.Get[ConverterMsg.kuserAbort], cvData]; 

}; 


—/* re-open dest in session */ 

IF dest # NSFile.nullHandle THEN 

{ 

ENABLE NSFile.Error = > 

{ 

NSFile.Close[dest, docSession ! NSFile.Error = > CONTINUE}; 
dest *— NSFile.nullHandle; 

CONTINUE; 

}; 

tmpRef: NSFile.Reference; 
tmp: NSFile.Handle «-dest; 

tmpRef *- NSFile.GetReference[file: dest, session: docSession]; 

dest «- NSFile.OpenByReferencelreference: tmpRef, session: avData.session]; 

NSFile.Closeltmp, docSession]; 

—/* if this process is dientBackg round, docSession must be logged off */ 

IF background THEN NSFile.LogoffldocSession ! NSFile. Error => CONTINUE]; 

}; 


EXITS err = > NULL; 

END; 

IF avData.input # NIL THEN Stream.Delete[avData.input]; 

IF avData.bik.blockPointer # NIL THEN 

avData.blk.blockPointer Space. IJnmaplavData.blk.blockPointer]; 

—/* destroy instance data if created by this proc call */ 

IFsrdnstance = NIL AND src# NIL THEN CvXlit.DestroyCommon[src]; 

IF dstlnstance = NIL ANDdst # NILTHEN CvXlit.DestroyCommon[dst]; 

IF finish # ok OR aborted THEN 

Post{ConverterMsg.Get[ConverterMsg.kdataSkipped], cvData]; 


CheckAbort: PROC [background: BOOLEAN] RETURNS [yes: BOOLEAN] = INLINE { 
yes*s-(background AND BackgroundProcess.UserAbort[]) OR 
{NOT background AND TIP.UserAbort[NIL]); 

); 


FlushText: PROC [av: AVData, para: XString.Writer] = { 

r: XString.Reader*-XString.ReaderFromWriterfpara]; 

IF CheckAbort[av.background] THEN ERROR ABORTED; 

IF XString.ByteLength[r] > OTHEN 

{ 

DoclnterchangeDefs,AppendText[ 
to: [doc[av.doc]], 
text: r, 

textEndContext: XString.WriterInfo[para].endContext, 
fontProps: @av.fontProps]; 

XString.ClearWriterlpara]; 

}; 


Post: PROC [msgRb; XString.ReaderBody, cvData: Converter.CvData] = { 
Converter.PostMessagel 
msg: @msgRb, 
cvData: cvData, 
cr: TRUE, 
clear: FALSE]; 
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< <: 


State Machine 

This, procedure implements a state graph, which is depicted in auxiliary documentation. The state machine handles the input data 
character by character, although the i/o is optimized using block buffers. Note that theXString.Writer "para" isthe output buffer 
that gets appended to the document every time text is flushed (see FlushText). Hereafter are described, briefly, the states, the entry 
conditions, exit conditions, and special circumstances: 

- entry 

The state machine is always entered here. The entry conditions are that the index "n" references the next character to be handled. The 
next state is determined by the value of the character "c". The mode "ignore" determines whether white space is treated as standard 
text, or as should be handled by the special ignoreTrailing state. If the character "c" matches the first character of the end of 
paragraph string "eopO", then the next state is endPara. Otherwise, the next state is "append". Note that the variable "nextState" 
does NOT refer to the state executed after entry, but rather the state that the next state RETURNS TO. Although this violates strict 
state machine implementation algorithms, it saves logic. 

- append 

The state is entered with the character "c", and a valid nextState. It translates the character "c" to a VP character, and appends it to 
the output buffer "para". Certain special cases are handled. The exit condition is a valid nextState, which becomes "state". 

- ignoreTrailing 

The purpose of this state is to implement deletion of white space that precedes an end of line sequence, if the user so desires. The 
state isentered eitherfrom entry with "c" being whitespace, or from ignoreTrailing, with "n" indicating the next characterto handle. 
Variables are initialized to indicate the beginning of whitespace characters. The state is exited if eopO is found, or a nonwhitespace 
character is found before the end of line. 

- maxEixceeded 

This state handles an overflow exception. It is entered if "para" is about to exceeded its limits. A new paragraph is forced if this 
state is entered. It returns to entry. 

- endPara 

This state tries to determine if the end of a paragraph has been found. It is entered if the character “c" matched eopO, or (from 
endPara itself) if the input text continues to match the string "s". If a paragraph ending is found, the paragraph is flushed. The 
state returns to entry either if there is a complete match, or of there is a mismatch. Several special cases are handled. 

The state machine loops until input is exhausted. 


> > 


StateMachine: PROC lav: AVData] = { 
lastBlock: BOOLEAN FALSE; 

flushed: BOOLEAN FALSE; —■/* controls appending text to doc */ 

ignore: BOOLEAN «-av.dst.f.ignoreTrailing.value, 

eop: CARDINAL *- 0; —/* index into paraEndsWith string */ 

para: XString.WriterBody«— X$tring,NewWriterBody[maxLength: paraLen, z: av.z]; 

state; AVState gentry; 

blankCount: CARDINAL <- 0; —/* count of "white" characters in buffer */ 

blkCount: CARDINAL *-0; —/* number of blocks read */ 

lastBIkCount: CARDINAL; —/* for saving "blkCount"*/ 

nextState: AVState; —/* the state a state goes back to */ 

getNextBlock: BOOLEAN; 

bytes: CARDINAL; 

why; Stream.CompletionCode; 

eopO: CHARACTER; —/* first character of end-of-paragraph text */ 
unknown: LONG STRING; —/* copy of user defined replacement text*/ 
blanksStart: CARDINAL; —/* index into buffer for beginning of blanks*/ 
imap: LONG POINTER TO CtoVPCharMap; 
amap: LONG POINTER TO CtoVPCharMap; 

blk: LONG POINTER TO PACKED ARRAY INTEGER(O. O) OF Environment.Byte; 

n: CARDINAL; —/* current character in blk */ 

last, 

c: CHARACTER; 

convertXlit: BOOLEAN <—TRUE; 


—/* initialize */ 
imap<~g.isomap; 
amap*- g.modmap; 

—/* para is a buffer of VP characters that gets appended to the doc */ 
XString.ClearWriter[@paraJ; 
eopO *- IF av.src.text[paraEndsWith] # NIL THEN 
av.src.text[paraEndsWith][01 

ELSE 

Ascii. NUL; 
last*-Ascii. NUL; 

unknown«-av.dst.text[atovReplaceUnknown]; 

IF unknown = NILTHEN 

{ 

—/* so we don't have to test for NIL again */ 
unknown *— ‘^“L; 
unknown. len gth 0; 

}; 

—/* make sure getNextBlock is TRUE first time */ 
n *- av.blk.stopIndexPlusOne; 
blk «— av.blk.blockPointer; 

—/* enter state graph */ 

DO 

getNextBlock «- n >= av.blk.stopIndexPlusOne; 

IF getNextBlock THEN 

{ 
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<< 


StateMachine 

This procedure implements a state graph, which is depicted in auxiliary documentation. The state machine handles the input data 
character by character, although the i/o is optimized using block buffers. Note that the XString.Writer "para" is the output buffer 
thctt gets appended to the document every time text is flushed {see FlushText). Hereafter are described, briefly, the states, the entry 
conditions, exit conditions, and special circumstances: 

- entry 

The state machine is always entered here. The entry conditions are that the index "n" references the next character to be handled. The 
next state is determined by the value of the character "c". The mode "ignore" determines whether white space is treated as standard 
text, or as should be handled by the special ignoreTrailing state. If the character "c" matches the first character of the end of 
paragraph string "eopO", then the next state isendPara. Otherwise, the next state is "append". Note that the variable "nextState" 
does MOT refer to the state executed after entry, but rather the state that the next state RETURNS TO. Although this violates strict 
state machine implementation algorithms, it saves logic. 

- append 

The state is entered with the character "c", and a valid nextState. It translates the character "c" to a VP character, and appends it to 
the output buffer "para". Certain special cases are handled. The exit condition is a valid nextState, which becomes "state". 

- ignoreTrailing 

The purpose of this state is to implement deletion of white space that precedes an end of line sequence, if the user so desires. The 
state is entered either from entry with "c" being whitespace, or from ignoreTrailing, with "n" indicating the next character to handle. 
Variables are initialized to indicate the beginning of whitespace characters. The state is exited if eopO is found, or a nonwhitespace 
character is found before the end of line. 

- maxExceeded 

This state handles an overflow exception. It is entered if "para" is about to exceeded its limits. A new paragraph is forced if this 
state is entered. It returns to entry. 

- endPara 

This state tries to determine if theendof a paragraph has been found. It is entered if the character "c" matched eopO,or {from 
endPara itself) if the input text continues to match the string "s“. If a paragraph ending is found, the paragraph is flushed. The 
state returns to entry either if there is a complete match, or of there is a mismatch. Several special cases are handled. 

The state machine loops until input is exhausted. 


> > 


StateMachine: PROC [av; AVData] = { 
lastBlock: BOOLEAN FALSE; 

flushed: BOOLEAN <— FALSE; —/* controls appending text to doc */ 

ignore: BOOLEAN <-av.dst.f.ignoreTrailing .value, 

eop: CARDINAL <6- 0; — I* index into paraEndsWith string */ 

para: XString.WriterBody *h~XS tring.NewWriterBody[maxLength; paraLen. z: av.zj; 

state: AVState gentry; 

blankCount: CARDINAL 0; —/* count of "white" characters in buffer */ 

blkCount: CARDINAL *~0; —/* numberof blocks read */ 

lastBIkCount: CARDINAL; —/* for saving "blkCount" */ 

nextState: AVState; —/* the state a state goes back to *1 

getNextBlock: BOOLEAN; 

bytes: CARDINAL; 

why: Stream.CompletionCode; 

eofk): CHARACTER; —/* first character of end-of-paragraph text */ 
unknown: LONG STRING; —/* copy of user defined replacement text *7 
blanksStart: CARDINAL; —/* index into buffer for beginning of blanks*/ 
imap: LONG POINTER TO CtoVPCharMap; 
amap: LONG POINTER TO CtoVPCharMap; 

blk; LONG POINTER TO PACKED ARRAY INTEGER[0..0) OF Environment.Byte; 

n: CARDINAL; —/* current character in blk */ 

last, 

c: CHARACTER; 

convertXlit: BOOLEAN TRUE; 

—/* initialize *1 
imap <-g.isomap; 
amap«- g.modmap; 

—/* para is a buffer of VP characters that gets appended to the doc */ 

XString.ClearWriter[@para); 
eopO<- IFav.srctextlparaEndsWith] # NIL THEN 
av.src.text[paraEndsWith][01 

ELSE 

Ascii,NUL; 
lastAscii.NUL; 

unknown <- av.d$t.text[atovRepiaceUnknown]; 

IF unknown = NILTHEN 

{ 

—/* so we don't have to test for NIL again */ 
unknown "?"L; 
unknown.length 0; 

}; 

—/* make sure getNextBlock is TRUE first time */ 
n «— av.blk.stopIndexPlusOne; 
blk <- av.blk.blockPointer; 

—/* enter state graph */ 

DO 

getNextBlock n >= av.blk.stopIndexPlusOne; 

IFgetNext8lock THEN 

{ 
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IF lastBlock THEN 


( 

—/* might have one last character pending *i 
IF state = append THEN 

{ 

nextState entry; 

GOTO onelastLoop; 

}; 

FlushText{av, @para]; 

EXIT; —/* state graph */ 

}; 

IFCheckAbortlav.background] THEN ERROR ABORTED; 
av.blk.stopindexPlusOne maxPara; 

[bytesTransferred: bytes, why: why]«— Stream,GetBlock] 
sH: av.input, 
block: av.blk]; 
lastBlock why # normal; 
av.blk.stopindexPlusOne «- bytes; 
blk <r~ av.blk. blockPointer; 
n «— 0; 

—/* guard against blkCount overflow */ 

blkCount IF blkCount = CARDINAL LAST THEN 0 ELSE blkCount + 1; 
EXITS oneLastLoop => NULL; 

}; 


SELECT state FROM 
entry = > 

{ 

— I* get next character */ 
c «- LOOPHOLE[blk[n], CHAR]; 

—/* set up next state */ 

SELECTc FROM 

Ascii.SP, Ascii.TAB => IF ignore THEN 

{ 

state <- ignoreTrailing; 
blanksStart*- n; 
blankCount«-0; 
lastBIkCount «- blkCount; 

} 

ELSE 

{ 

state append; 
nextState entry; 
n n + 1 ; 

}; 

eopO = > 

{ 

state *r- end Para; 

}; 

ENDCASE -> 

{ 

state«-append; 
nextState «-■ entry; 
n n + 1; 

}; 

}; 

append —> 

{ 

— I* ASSERT: order of select arms is critically important *t 
SELECT c FROM 

'# = > — 74C, toggle convert switch 

{ 

convertXlit~convertXlit; 

XString.AppendCharfto: @para, cp map]'#], extra: paraLen]; 
state «-nextState; Lx 

}; 

'* = > — 52C, word separator 

{ 

XString.AppendCharfto: @para, c: imap[Ascii.SPl, extra: paraLen]; 
state <— nextState; 

}; 

'( = > 

{ 

—/* reverse parentheses in right to left paragraphs */ 
IFavparaProps.basicProps.streakSuccaasjon = rightToLeftTHEN 
XString.AppendCharfto: @para, d.\ nmap(')], extra: paraLen] 
ELSE (y 

XString.AppendChar(to: @para, c: imap[c], extra: paraLen]; 
state nextState; 

}; 

')=> 

{ 

—/* reverse parentheses in right to left paragraphs */ 

IF av.paraProps.basicProps.streakSuccession = rightToLeftTHEN 
XString.AppendChar[to: @para, c:ffimap['(], extra: paraLen] 
ELSE W 

XString.AppendChar[to: @para, c: imap[c], extra: paraLen]; 
state <-nextState; 

h 

'[=> 

{ 

—/* reverse brackets in right to left paragraphs */ 

IF av.paraProps.basicProps.streakSuccession = rightToLeftTHEN 
XString.AppendCharfto: @para, c:|amap[']], extra: paraLen] 
ELSE 1/ 

XString.AppendChar[to: @para,c: imapfc], extra: paraLen]; 
state nextState; 
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1 => 

{ 

—/* reverse brackets in right to left paragraphs *7 
IF av.paraProps.basicProps.streakSucces^ion = rightToLeft THEN 
XString,AppendChar[to: @para,c:/amfipr[], extra: paraLen] 
ELSE LS 

XString.AppendCharlto: @para,c: imap[c], extra: paraLen]; 
state nextState; 

}; 

'{ = > 

{ 

—/* reverse braces in right to left paragraphs */ 

IF av.paraProps.basicProps.streakSucc«s)pn = rightToLeft THEN 
XString.AppendChar(to: @para, cl amrapO], extra: paraLen] 
ELSE W 

XString.AppendCharlto: @para,c: imap[c], extra: paraLen]; 
state <- nextState; 

>; 

'} = > 


’p,'p =: 
{ 


—/* reverse braces in right to left paragraphs */ 
IFav.paraProps.basicProp$.streakSucc&»ion = rightToLeftTHEN 
XString.AppendCharlto: @para, arWiapl'{], extra: paraLen] 
ELSE ^ 

XString.AppendChar[to: @para, c: imap[c], extra: paraLen]; 
state nextState; 

-fe- 



IF convertXlit THEN 

FOR i: CARDINAL IN [O..unknown.length) DO 

XString.AppendCharlto: @para,c; imap(unknown]i]], extra: paraLen]; 
ENDLOOP 
ELSE 

XString.AppendCharlto: @para,c: imapjc ], extra: paraLen ]; 

_stat e «— next^a^e ^_^ -—’ 

l^l4bc^76C]72^cT253C, 273C, 277cJ= > 

IF convertXlit THEN 

XString.AppendCharlto: @para, c: amap]c], extra: paraLen] 

ELSE 

XString.AppendCharlto: @para, c: imap(c], extra: paraLen]; 
statenextState; 

}; 


IF CheckAbort[av.background] THEN ERROR ABORTED ; 
IF nextState = entry THEN 
( 

—/* smart white space */ 

SELECT last FROM 
Ascii. SP, 

Ascii.TAB, 

Ascii.CR, 

Ascii. LF, 

aHyphen = > NULL; —/* just drop CR */ 
ENDCASE = > 


{ 

XString.AppendChar] 
to: @para, 
c: imapJAscii.SP], 
extra: paraLen]; 

}; 

}; 

—/* CR is skipped if we came from endPara *7 
state nextState; 

}; 

Ascii. LF = > 

{ 

IF last # Ascii.CR AND nextState # endPara THEN 


{ 

—/* append newline */ 

XString.AppendChar] 
to: @para, 
c: xNewLine, 
extra: paraLen]; 

>; 

—/* LF is skipped if we came from endPara */ 

—/* or if last = CR */ 
state nextState; 

}; 

Ascii.TAB => 

{ 

—/* tab */ 

XString.AppendCharlto: @para, c: imap[c], extra: paraLen]; 
state «- nextState; 

}; 

Ascii.FF = > 

{ 

—/* flush page */ 

FlushText(av, @para]; 
DocInterchangeDefs.AppendPageBreak] 
to: av.doc, 

fontProps; @av.fontProps]; 
state «— nextState; 
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}; 

Ascii.NUL = > 

{ 

—/* skip */ 
state «— nextState; 

}; 

ENDCASE => 

{ 

—/* exceptions */ 

FOR i: CARDINAL IN [O..unknown.length) DO 

XString.AppendChar]to: @para, c: imap[unknown[i]], extra: paraLen]; 
ENDLOOP; 
state <- nextState; 

}; 

last <- c; 

<< 

* XString.Character-Length is an expensive operation. 

* We make the observation that 

* ByteLength > = CharacterLength ALWAYS. Therefore 

* use faster ByteLength to determine if CharacterLength should 

* be called 
>> 

IF XString.ByteLength[XString.ReaderFromWriter]@paraj] > maxParaTHEN 

{ 

IFXString.CharacterLength[XString.ReaderFromWriter[@para]] > maxPara 
AND nextState # endPara THEN 
state maxExceeded; 

}; 

}; 

ignoreTrailing — > 

{ 

—/* get next char if other than first entry */ 

IF blanksStart # n THEN 

{ 

last «- c; 

c LOOPHOLElblkln), CHAR]; 

SELECT c FROM 

Ascii.SP, Ascii.TAB = > 

{ 

state ignoreTrailing; 
n«-n + 1; 

blankCount*-blankCount + 1; 

}; 

eopO = > 

{ 

—/* end found, so skip all trailing blanks *1 
state endPara; 

}; 

Ascii.CR = > 

{ 

—/* NOTE: this arm must follow the eopO arm */ 

—/* ASSERT: eopO # Ascii.CR by order of execution */ 

—/* replace CR with space, and skip blanks */ 

XString. AppendChar] 
to: @para, 
c: imaplAscii.SP], 
extra; paraLen]; 
state entry; 
blankCount<~- 0; 
n n + 1; 

}; 

ENDCASE => 

{ 

IF CheckAbort[av.background] THEN ERROR ABORTED; 

—/* whoops! Noteol, so append */ 

IF {lastBIkCount # blkCount) THEN 

{ 

—/* blanks straddle blocks */ 

THROUGH [1 ..blankCount] DO 
XString .AppendChar] 
to: @para, 
c: imaplAscii.SP], 
extra: paraLen]; 

ENDLOOP; 

} 

ELSE 

FOR i: CARDINAL IN [b!anksStart..n) DO 
XString .AppendChar] 
to: @para, 

c: imap]LOOPHOLE[blk]i], CHAR]], 
extra: paraLen]; 

ENDLOOP; 
blankCount <-0; 
state«— entry; 

}'• 

}; 

maxExceeded = > 

{ 

FlushTextlav, @para]; 

IF convertXlit THEN 

{ 

—/*set paragraph properties for Xlit */ 
av.paraProps.basicProps.streakSuccession <- rightToLeft; 
av.paraProps.basicProps.paraAlignment <— right; 

} 


CvXIitToVPImpi.mesa 7-Sep-89 16:59:06 PDT 


9 



ELSE 


<* 


{ 

—/* set paragraph properties for English *7 
av.paraProps.basicProps.streakSuccession«— leftToRight; 
av.paraProps.basicProps.paraAlignment «- left; 

}; 

DocInterchangeDefs.AppendNewPa rag ra ph [ 
to: [doc(av.doc]] f 
paraProps: @av.paraProps, 
fontProps: @av.fontProp$, 
nToAppend: 1]; 

state entry ; 

}; 

endPara = > 

t 

s: LONG STRING *- av.src,text[paraEndsWith], 

IPs = NILTHEN 

{ 

state entry ; 
nextState *r~ entry; 
n n + 1 ; 
flushed«— FALSE; 

GOTO restart; 


IF eop # 0 THEN 

{ 

lastc; 

cLOOPHOLE[blk(n], CHAR]; 

}; 


—/* if we are at the end of s, then matchl */ 
IF eop > = s.length THEN 

{ 

IF NOT flushed THEN 

—/* flush all text */ 

FlushText[av, @para]; 



:HtTHEN- 


—/* set paragraph properties for Xlit *7 
av.paraProps.basicProps.streakSuccession rightToLeft, 
av.paraProps.basicProps.paraAlignment <- right; 

ELSE 


—/* set paragraph properties for English */ 
av.paraProps.basicProps.streakSuccession leftToRight 
av.paraProps.basicProps.paraAlignment *- left; 


DodnterchangeDefs.AppendNewParagraph] 
to: ldoc[av.doc)], 
paraProps: @av.paraProps, 
fontProps: @av.fontProps, 




IF flushed THEN 

—/* flush following text */ 
FlushText[av, @para]; 


eop«r-0; 
state entry; 
nextState «- entry; 
flushed «- FALSE; 
GOTO restart; 

>; 


—/* c match with end-of-paragraph? *7 
IFs[eop] = cTHEN 
{ 

eop <— eop + 1; 
n <- n + 1 ; 

} 

ELSE 

{ 

— I* false alarm */ 

IF ignore THEN 

—/* ouch, we interrupted ignoreTrailing *1 
FOR j: CARDINAL IN [O..eop) DO 

IF s|j] = Ascii.CR THEN GOTO oneCR; 

IF s[j] # Ascii.SP OR s|jj # Ascii.TAB THEN 
GOTO notWhite; 

REPEAT 

oneCR = > 

{ 

—/* replace CR with one blank */ 
XString.AppendCharl 
to: @para, 
c: imap[Ascii.SP], 
extra: paraLen]; 

—/* other blanks ignored */ 
blankCount «-0; 

}; 

notWhite = > 

{ 

—/* flush blankCount characters *1 
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* 


> 

IF (lastBIkCount # blkCount)THEN 

{ 

—/* blanks straddle blocks */ 

THROUGH [1,blankCount] DO 
XString.AppendChar( 
to: @para, 
c: imap[Ascii.SP], 
extra: paraLen]; 

ENDLOOP; 


ELSE 

FOR i: CARDINAL IN IblanksStart..blanksStart+blankCount) DO 
XString.AppendCharl 
to: @para, 

c: imap[LOOPHOLE(bIklr], CHAR]], 
extra: paraLen]; 

ENDLOOP; 
blankCount«■— 0; 

}; 

FINISHED => 

{ 

—/* include current chars in blankCount */ 
blankCountblankCount + (MAX[eop,1] - 1); 
state ignoreTrailing; 

}; 

ENDLOOP; 

—!* set up for next state */ 

IF (c = Ascii.SP OR c = Ascii.TAB) 

AND ignore 

AND state # ignoreTrailing THEN 

{ 

state ignoreTrailing; 
blanksStart«— n; 
blankCount *~0; 
lastBIkCountblkCount; 

} 

ELSE 

{ 

state append; 
n n + 1; 

—/* account for any CRs */ 

—/* IF last = CR, then kludge handled it *1 
IF last #Ascii,CR THEN 

FOR j: CARDINAL IN [O..eop) DO 

IF s[j] = Ascii.CR THEN GOTO foundCR; 

REPEAT 

foundCR => 

{ 

—/* replace one or more CRs with one blank */ 
XString.AppendChar{ 
to: @para, 
c: imapIAscii.SP], 
extra: paraLen]; 

}; 

FINISHED => NULL; 

ENDLOOP; 


eop<— 0; 

nextState gentry; 
flushed -t- FALSE; 

GOTO restart; 

—/* end of false alarm */ 

}; 


—/* continue looking for eop */ 

IF c = Ascii.CR THEN 

{ 

—/* flush preceding text, clear buffer */ 

FlushText[av, @para]; 
flushed TRUE; 

}; 

— I* translate character */ 
state append; 
nextState <- endPara; 

—/* special look-ahead kludge to make naked CR's work *1 
IF c = Ascii.CR 
AND NOT ignore 
AND eop < s.length 
AND n < av.blk.stopIndexPlusOne 
AND s[eop] # LOOPHOLE[blkIn], CHAR] THEN 
{ 

—/* smart white space */ 

SELECT last FROM 
Ascii.SP, 

Ascii.TAB, 

Ascii.CR, 

Ascii. LF, 

aHyphen = > NULL; —/* just drop CR */ 
ENDCASE -> 

{ 

XString.AppendCharl 
to: @para, 
c: imapIAscii.SP], 
extra: paraLen]; 
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}; 

}; 

EXITS restart = > NULL; 

}; 

ENDCASE; 

ENDLOOP; 

—/* clean up */ 

XString.FreeWriterBytes[@para]; 

}; 


UserAbortsPaginate: DocInterchangeDefs.CheckAbortProc = { 

< < = PROCEDURE [clientData: LONG POINTER] RETURNS [abort: BOOL]; 

> > 

data: AVData = clientData; 

abortCheckAbortJdata. background]; 


Zzlnit: PROC = { 

pz: UNCOUNTED ZONE = BWSZone.Permanent!]; 

—/* these Spaces should not be unmapped while this application is loaded *7 
9 *— I 

isomap: Space.ScratchMap[(words + Environment.wordsPerPage-1) / EnvironmentwordsPerPage], 
modmap: Space.ScratchMap[(words + Environment.wordsPerPage-1) / Environment.wordsPerPage], 
pz: pzl: 

—/* initialize conversion maps */ 

FOR c: CHARACTER IN CHARACTER DO 

temp: XString.Character <-XCharSetO.Make[LOOPHOLE[c]]; 
g.isomap[c] temp; 
g.modmap[c] «— temp; 

ENDLOOP; 


—I* main line code */ 
ZzInitU; 


END... 

LOC3 

16-Mar-87 14:06:16 - Caro - Created 

26-Jun-87 11:21:47 ~ Caro - Added error catcher in ConvertProcoverCreateCommon, 
Caught NSFile.Error in Logoff 
29- Jun-87 13:13:00 - Caro - Added lineHtlnPoints, AFTER setting 
10- J ul—87 10:55:05 - Caro - Added aHyphen testing for smart spacing 
19-Aug-87 11:01:32 —- Caro - Fixed AR 13535 by updating oldlnstance window 
16-Sep-87 13:48:21 - Caro - isomap accentFirst from 241C to 301C 

isomap lowGraphFirst from 0 to 241C 
isomap lowGraph Last from Oto 277C 
pcmap accentLast from 257C to 245C 
pcmap hiGraphFirstfrom 260C to 246C 

12~Feb-88 12:58:57 - Shinsato - In AtoV, made sure eop # NIL before counting CR 

in eop. 
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